1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311 | -- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (c) 2017 onox <denkpadje@gmail.com>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
with System.Multiprocessors.Dispatching_Domains;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Exceptions;
with Orka.Futures;
with Orka.Loggers;
with Orka.Logging.Default;
with Orka.Simulation;
with Orka.Simulation_Jobs;
package body Orka.Loops is
use all type Orka.Logging.Default_Module;
use all type Orka.Logging.Severity;
use Orka.Logging;
procedure Log is new Orka.Logging.Default.Generic_Log (Engine);
function "+" (Value : Ada.Real_Time.Time_Span) return Duration
renames Ada.Real_Time.To_Duration;
procedure Free is new Ada.Unchecked_Deallocation
(Behaviors.Behavior_Array, Behaviors.Behavior_Array_Access);
function "<" (Left, Right : Behaviors.Behavior_Ptr) return Boolean is
function Convert is new Ada.Unchecked_Conversion
(Source => System.Address, Target => Long_Integer);
begin
return Convert (Left.all'Address) < Convert (Right.all'Address);
end "<";
protected body Handler is
procedure Stop is
begin
Stop_Flag := True;
end Stop;
procedure Set_Frame_Limit (Value : Time_Span) is
begin
Limit := Value;
end Set_Frame_Limit;
function Frame_Limit return Time_Span is (Limit);
procedure Enable_Limit (Enable : Boolean) is
begin
Limit_Flag := Enable;
end Enable_Limit;
function Limit_Enabled return Boolean is (Limit_Flag);
function Should_Stop return Boolean is (Stop_Flag);
end Handler;
protected body Scene is
procedure Add (Object : Behaviors.Behavior_Ptr) is
begin
Behaviors_Set.Insert (Object);
Modified_Flag := True;
end Add;
procedure Remove (Object : Behaviors.Behavior_Ptr) is
begin
Behaviors_Set.Delete (Object);
Modified_Flag := True;
end Remove;
procedure Replace_Array (Target : in out Behaviors.Behavior_Array_Access) is
pragma Assert (Modified);
Index : Positive := 1;
Count : constant Positive := Positive (Behaviors_Set.Length);
begin
Free (Target);
Target := new Behaviors.Behavior_Array'(1 .. Count => Behaviors.Null_Behavior);
-- Copy the elements from the set to the array
-- for faster iteration by the game loop
for Element of Behaviors_Set loop
Target (Index) := Element;
Index := Index + 1;
end loop;
Modified_Flag := False;
end Replace_Array;
function Modified return Boolean is
(Modified_Flag);
procedure Set_Camera (Camera : Cameras.Camera_Ptr) is
begin
Scene_Camera := Camera;
end Set_Camera;
function Camera return Cameras.Camera_Ptr is
(Scene_Camera);
end Scene;
package SJ renames Simulation_Jobs;
procedure Stop_Loop is
begin
Handler.Stop;
end Stop_Loop;
procedure Run_Game_Loop
(Fence : not null access SJ.Fences.Buffer_Fence;
Render : Simulation.Render_Ptr)
is
subtype Time is Ada.Real_Time.Time;
Previous_Time : Time := Clock;
Next_Time : Time := Previous_Time;
Lag : Time_Span := Time_Span_Zero;
Scene_Array : not null Behaviors.Behavior_Array_Access := Behaviors.Empty_Behavior_Array;
Batch_Length : constant := 10;
One_Second : constant Time_Span := Seconds (1);
Frame_Counter : Natural := 0;
Exceeded_Frame_Counter : Natural := 0;
Clock_FPS_Start : Time := Clock;
Stat_Sum : Time_Span := Time_Span_Zero;
Stat_Min : Duration := To_Duration (One_Second);
Stat_Max : Duration := To_Duration (-One_Second);
begin
Scene.Replace_Array (Scene_Array);
Log (Debug, "Simulation tick resolution: " & Trim (Image (+Tick)));
-- Based on http://gameprogrammingpatterns.com/game-loop.html
loop
declare
Current_Time : constant Time := Clock;
Elapsed : constant Time_Span := Current_Time - Previous_Time;
begin
Previous_Time := Current_Time;
Lag := Lag + Elapsed;
exit when Handler.Should_Stop;
declare
Iterations : constant Natural := Lag / Time_Step;
begin
Lag := Lag - Iterations * Time_Step;
Scene.Camera.Update (To_Duration (Lag));
declare
Fixed_Update_Job : constant Jobs.Job_Ptr
:= Jobs.Parallelize (SJ.Create_Fixed_Update_Job
(Scene_Array, Time_Step, Iterations),
SJ.Clone_Fixed_Update_Job'Access,
Scene_Array'Length, Batch_Length);
Finished_Job : constant Jobs.Job_Ptr := SJ.Create_Finished_Job
(Scene_Array, Time_Step, Scene.Camera.View_Position, Batch_Length);
Render_Scene_Job : constant Jobs.Job_Ptr
:= SJ.Create_Scene_Render_Job (Render, Scene_Array, Scene.Camera);
Render_Start_Job : constant Jobs.Job_Ptr
:= SJ.Create_Start_Render_Job (Fence);
Render_Finish_Job : constant Jobs.Job_Ptr
:= SJ.Create_Finish_Render_Job (Fence);
Handle : Futures.Pointers.Mutable_Pointer;
Status : Futures.Status;
begin
Orka.Jobs.Chain
((Render_Start_Job, Fixed_Update_Job, Finished_Job,
Render_Scene_Job, Render_Finish_Job));
Job_Manager.Queue.Enqueue (Render_Start_Job, Handle);
declare
Frame_Future : constant Orka.Futures.Future_Access := Handle.Get.Value;
begin
select
Frame_Future.Wait_Until_Done (Status);
or
delay until Current_Time + Maximum_Frame_Time;
raise Program_Error with
"Maximum frame time of " & Trim (Image (+Maximum_Frame_Time)) &
" exceeded";
end select;
end;
end;
end;
if Scene.Modified then
Scene.Replace_Array (Scene_Array);
end if;
declare
Total_Elapsed : constant Time_Span := Clock - Clock_FPS_Start;
Limit_Exceeded : constant Time_Span := Elapsed - Handler.Frame_Limit;
begin
Frame_Counter := Frame_Counter + 1;
if Limit_Exceeded > Time_Span_Zero then
Stat_Sum := Stat_Sum + Limit_Exceeded;
Stat_Min := Duration'Min (Stat_Min, To_Duration (Limit_Exceeded));
Stat_Max := Duration'Max (Stat_Max, To_Duration (Limit_Exceeded));
Exceeded_Frame_Counter := Exceeded_Frame_Counter + 1;
end if;
if Total_Elapsed > One_Second then
declare
Frame_Time : constant Time_Span := Total_Elapsed / Frame_Counter;
FPS : constant Integer := Integer (1.0 / To_Duration (Frame_Time));
begin
Log (Debug, Trim (FPS'Image) & " FPS, frame time: " &
Trim (Image (+Frame_Time)));
end;
if Exceeded_Frame_Counter > 0 then
declare
Stat_Avg : constant Duration := +(Stat_Sum / Exceeded_Frame_Counter);
begin
Log (Debug, " deadline missed: " &
Trim (Exceeded_Frame_Counter'Image) & " (limit is " &
Trim (Image (+Handler.Frame_Limit)) & ")");
Log (Debug, " avg/min/max: " &
Image (Stat_Avg) &
Image (Stat_Min) &
Image (Stat_Max));
end;
end if;
Clock_FPS_Start := Clock;
Frame_Counter := 0;
Exceeded_Frame_Counter := 0;
Stat_Sum := Time_Span_Zero;
Stat_Min := To_Duration (One_Second);
Stat_Max := To_Duration (Time_Span_Zero);
end if;
end;
if Handler.Limit_Enabled then
-- Do not sleep if Next_Time fell behind more than one frame
-- due to high workload (FPS dropping below limit), otherwise
-- the FPS will be exceeded during a subsequent low workload
-- until Next_Time has catched up
if Next_Time < Current_Time - Handler.Frame_Limit then
Next_Time := Current_Time;
else
Next_Time := Next_Time + Handler.Frame_Limit;
delay until Next_Time;
end if;
end if;
end;
end loop;
Job_Manager.Shutdown;
exception
when others =>
Job_Manager.Shutdown;
raise;
end Run_Game_Loop;
procedure Run_Loop
(Render : not null access procedure
(Scene : not null Behaviors.Behavior_Array_Access;
Camera : Cameras.Camera_Ptr))
is
Fence : aliased SJ.Fences.Buffer_Fence := SJ.Fences.Create_Buffer_Fence (Regions => 4);
begin
declare
-- Create a separate task for the game loop. The current task
-- will be used to dequeue and execute GPU jobs.
task Simulation;
task body Simulation is
begin
System.Multiprocessors.Dispatching_Domains.Set_CPU (1);
Run_Game_Loop (Fence'Unchecked_Access, Render);
exception
when Error : others =>
Log (Loggers.Error, Ada.Exceptions.Exception_Information (Error));
end Simulation;
begin
System.Multiprocessors.Dispatching_Domains.Set_CPU (1);
-- Execute GPU jobs in the current task
Job_Manager.Execute_GPU_Jobs;
end;
end Run_Loop;
end Orka.Loops;
|