Changeset 9 for trunk/Packages
- Timestamp:
- Aug 29, 2016, 5:17:45 PM (8 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 3 3 lib 4 4 heaptrclog.trc 5 ChronOS.exe
-
- Property svn:ignore
-
trunk/Packages/Kernel
-
Property svn:ignore
set to
lib
-
Property svn:ignore
set to
-
trunk/Packages/Kernel/Kernel.lpk
r8 r9 19 19 </Parsing> 20 20 </CompilerOptions> 21 <Files Count="1 0">21 <Files Count="12"> 22 22 <Item1> 23 23 <Filename Value="UAPI.pas"/> … … 60 60 <UnitName Value="UScreen"/> 61 61 </Item10> 62 <Item11> 63 <Filename Value="UIPC.pas"/> 64 <UnitName Value="UIPC"/> 65 </Item11> 66 <Item12> 67 <Filename Value="UScheduler.pas"/> 68 <UnitName Value="UScheduler"/> 69 </Item12> 62 70 </Files> 63 71 <RequiredPkgs Count="1"> -
trunk/Packages/Kernel/Kernel.pas
r8 r9 9 9 uses 10 10 UAPI, UApp, UClasses, UFileSystem, UGraphics, UKernel, UList, UMemory, 11 UDevice, UScreen, LazarusPackageIntf;11 UDevice, UScreen, UIPC, UScheduler, LazarusPackageIntf; 12 12 13 13 implementation -
trunk/Packages/Kernel/UAPI.pas
r8 r9 6 6 7 7 uses 8 Classes, SysUtils, UList, UKernel, DateUtils, UMemory, UScreen, UDevice; 8 Classes, SysUtils, UList, DateUtils, UMemory, UScreen, UDevice, UIPC, 9 UScheduler; 9 10 10 11 type … … 13 14 14 15 TAPI = class 15 Kernel: T Kernel;16 Kernel: TObject; //TKernel; 16 17 procedure WriteText(Text: string); 17 18 procedure DrawText(P: TPoint; Text: string; Color: TColor); … … 27 28 implementation 28 29 30 uses 31 UKernel; 32 29 33 { TAPI } 30 34 … … 33 37 Device: TDeviceSerial; 34 38 begin 35 Device := TDeviceSerial( Kernel.Devices.FindByName('Serial0'));39 Device := TDeviceSerial(TKernel(Kernel).Devices.FindByName('Serial0')); 36 40 if Assigned(Device) then begin 37 41 Device.WriteText(Text); … … 43 47 Screen: TScreen; 44 48 begin 45 Screen := TScreen( Kernel.Screens.First);49 Screen := TScreen(TKernel(Kernel).Screens.First); 46 50 Screen.DrawText(P, Text, Color); 47 51 end; … … 51 55 Screen: TScreen; 52 56 begin 53 Screen := TScreen( Kernel.Screens.First);57 Screen := TScreen(TKernel(Kernel).Screens.First); 54 58 Screen.DrawLine(P1, P2, Color); 55 59 end; … … 59 63 Screen: TScreen; 60 64 begin 61 Screen := TScreen( Kernel.Screens.First);65 Screen := TScreen(TKernel(Kernel).Screens.First); 62 66 Screen.DrawRect(Rect, Color); 63 67 end; … … 67 71 Task: TTask; 68 72 begin 69 Task := Kernel.Scheduler.GetCurrentTask;73 Task := TKernel(Kernel).Scheduler.GetCurrentTask; 70 74 Task.Sleep(Time); 71 75 end; … … 75 79 Task: TTask; 76 80 begin 77 Task := Kernel.Scheduler.GetCurrentTask;78 while Task.Messages. Count = 0 do Task.WaitForMessage;81 Task := TKernel(Kernel).Scheduler.GetCurrentTask; 82 while Task.Messages.List.Count = 0 do Task.WaitForMessage; 79 83 end; 80 84 -
trunk/Packages/Kernel/UApp.pas
r8 r9 6 6 7 7 uses 8 Classes, SysUtils, UList, UAPI, U Kernel;8 Classes, SysUtils, UList, UAPI, UScheduler; 9 9 10 10 type -
trunk/Packages/Kernel/UFileSystem.pas
r8 r9 20 20 21 21 TDirectory = class(TFileSystemObject) 22 Items: TNamedObjectList ; // TList<TFileSystemObject>22 Items: TNamedObjectList<TFileSystemObject>; 23 23 constructor Create; 24 24 destructor Destroy; override; … … 54 54 constructor TDirectory.Create; 55 55 begin 56 Items := TNamedObjectList .Create;56 Items := TNamedObjectList<TFileSystemObject>.Create; 57 57 end; 58 58 -
trunk/Packages/Kernel/UKernel.pas
r8 r9 6 6 7 7 uses 8 Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice; 8 Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice, 9 fgl, UApp, UScheduler; 9 10 10 11 type 11 TTask = class;12 TScheduler = class;13 14 TTaskEvent = procedure(Task: TTask) of object;15 16 TTaskState = (tsStopped, tsRunning, tsSuspended, tsWaiting);17 18 TIPCMessage = class19 Name: string;20 Action: string;21 22 end;23 24 TWaitReason = (wrSleep, wrMessage);25 26 { TTask }27 28 TTask = class(TNamedObject)29 Scheduler: TScheduler;30 State: TTaskState;31 WaitReason: TWaitReason;32 WakeUpTime: TDateTime;33 Terminated: Boolean;34 EntryPoint: TTaskEvent;35 Messages: TObjectQueue; // TQueue<TIPMessage>36 procedure WaitForMessage;37 procedure Sleep(Duration: TDateTime);38 constructor Create; virtual;39 destructor Destroy; override;40 end;41 42 TTaskClass = class of TTask;43 44 { TScheduler }45 46 TScheduler = class47 TaskClass: TTaskClass;48 Tasks: TNamedObjectList; // TList<TTask>49 Running: Boolean;50 function GetCurrentTask: TTask; virtual;51 procedure Start; virtual;52 procedure Stop; virtual;53 function AddTask(Name: string; EntryPoint: TTaskEvent): TTask; virtual;54 procedure SwitchNext; virtual;55 constructor Create; virtual;56 destructor Destroy; override;57 end;58 59 TSchedulerClass = class of TScheduler;60 61 12 { TDrive } 62 13 … … 77 28 procedure InitVideo; 78 29 public 79 Apps: TNamedObjectList ; // TList<TApp>80 Drives: TNamedObjectList ; // TList<TDrive>30 Apps: TNamedObjectList<TApp>; 31 Drives: TNamedObjectList<TDrive>; 81 32 Scheduler: TScheduler; 82 33 SchedulerClass: TSchedulerClass; 83 34 FileSystemClass: TFileSystemClass; 84 Devices: TNamedObjectList ; // TList<TDevice>85 Screens: T ObjectList; // TList<TScreen>35 Devices: TNamedObjectList<TDevice>; 36 Screens: TFPGObjectList<TScreen>; 86 37 procedure AppExecute(AFile: TFile); 87 38 procedure Init; … … 92 43 93 44 implementation 94 95 uses96 UApp;97 45 98 46 … … 107 55 begin 108 56 FileSystem.Free; 109 inherited Destroy;110 end;111 112 { TTask }113 114 procedure TTask.WaitForMessage;115 begin116 WaitReason := wrMessage;117 State := tsWaiting;118 Scheduler.SwitchNext;119 end;120 121 procedure TTask.Sleep(Duration: TDateTime);122 begin123 WakeUpTime := Now + Duration;124 State := tsWaiting;125 WaitReason := wrSleep;126 Scheduler.SwitchNext;127 end;128 129 constructor TTask.Create;130 begin131 Messages := TObjectQueue.Create;132 end;133 134 destructor TTask.Destroy;135 begin136 Messages.Free;137 inherited Destroy;138 end;139 140 { TScheduler }141 142 function TScheduler.GetCurrentTask: TTask;143 begin144 Result := nil;145 end;146 147 procedure TScheduler.Start;148 begin149 Running := True;150 end;151 152 procedure TScheduler.Stop;153 begin154 Running := False;155 end;156 157 function TScheduler.AddTask(Name: string; EntryPoint: TTaskEvent): TTask;158 var159 NewTask: TTask;160 begin161 NewTask := TaskClass.Create;162 NewTask.Scheduler := Self;163 NewTask.Name := Name;164 NewTask.EntryPoint := EntryPoint;165 Tasks.Add(NewTask);166 Result := NewTask;167 end;168 169 procedure TScheduler.SwitchNext;170 begin171 172 end;173 174 constructor TScheduler.Create;175 begin176 TaskClass := TTask;177 Tasks := TNamedObjectList.Create;178 end;179 180 destructor TScheduler.Destroy;181 begin182 if Running then Stop;183 Tasks.Free;184 57 inherited Destroy; 185 58 end; … … 264 137 constructor TKernel.Create; 265 138 begin 266 Devices := TNamedObjectList .Create;267 Drives := TNamedObjectList .Create;268 Apps := TNamedObjectList .Create;139 Devices := TNamedObjectList<TDevice>.Create; 140 Drives := TNamedObjectList<TDrive>.Create; 141 Apps := TNamedObjectList<TApp>.Create; 269 142 Scheduler := TScheduler.Create; 270 Screens := T ObjectList.Create;143 Screens := TFPGObjectList<TScreen>.Create; 271 144 end; 272 145 -
trunk/Packages/Kernel/UList.pas
r8 r9 6 6 7 7 uses 8 Classes, SysUtils, Contnrs ;8 Classes, SysUtils, Contnrs, fgl; 9 9 10 10 type … … 18 18 { TNamedObjectList } 19 19 20 TNamedObjectList = class(TObjectList)21 function FindByName(Name: string): T NamedObject;20 TNamedObjectList<T> = class(TFPGObjectList<T>) 21 function FindByName(Name: string): T; 22 22 end; 23 23 … … 27 27 { TNamedObjectList } 28 28 29 function TNamedObjectList .FindByName(Name: string): TNamedObject;29 function TNamedObjectList<T>.FindByName(Name: string): T; 30 30 var 31 31 I: Integer; … … 33 33 I := 0; 34 34 while (I < Count) and (TNamedObject(Items[I]).Name <> Name) do Inc(I); 35 if I < Count then Result := TNamedObject(Items[I])35 if I < Count then Result := Items[I] 36 36 else Result := nil; 37 37 end;
Note:
See TracChangeset
for help on using the changeset viewer.