forked from AdaDoom3/AdaDoom3
-
Notifications
You must be signed in to change notification settings - Fork 0
/
neo-system-processor.adb
339 lines (338 loc) · 10.6 KB
/
neo-system-processor.adb
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
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
--
--
--
--
--
--
--
--
--
--
--
--
--
--
--
--
package body Neo.System.Processor
is
--------------------
-- Implementation --
--------------------
package body Implementation_For_Compiler
is separate;
package body Implementation_For_Architecture
is separate;
package body Implementation_For_Operating_System
is separate;
----------
-- Test --
----------
procedure Test
is
-----------
procedure A
-----------
is
begin
Put_Trace;
end A;
-----------
procedure B
-----------
is
begin
A;
end B;
-----------
procedure C
-----------
is
begin
B;
end C;
-----------
procedure D
-----------
is
begin
C;
end D;
Specifics : constant Record_Specifics := Get_Specifics;
begin
Put_Title("PROCESSOR TEST");
Set_Precision(Double_Extended_Precision);
Set_Rounding(Nearest_Rounding);
Check_Exceptions;
Put_Line("Clock ticks: " & Integer_8_Unsigned'Wide_Image(Get_Clock_Ticks));
Put_Line("Sleep...");
delay 0.5;
Put_Line("Clock ticks: " & Integer_8_Unsigned'Wide_Image(Get_Clock_Ticks));
Put_Line("Sleep...");
delay 1.0;
Put_Line("Clock ticks: " & Integer_8_Unsigned'Wide_Image(Get_Clock_Ticks));
Put_Line("Number of cores:" & Integer_8_Unsigned'Wide_Image(Get_Number_Of_Cores));
Put_Line("Speed in megahertz:" & Integer_8_Unsigned'Wide_Image(Get_Speed_In_Megahertz));
Put_Line("Vendor: " & Enumerated_Vendor'Wide_Image(Specifics.Vendor));
case Specifics.Vendor is
when ARM_Licenced_Vendor =>
if Specifics.Has_NEON then
Put_Line("Has NEON");
end if;
if Specifics.Has_Vector_Floating_Point then
Put_Line("Has VFP");
end if;
when Apple_IBM_Motorola_Vendor =>
if Specifics.Has_Vector_Multimedia_Instructions then
Put_Line("Has VMI");
end if;
if Specifics.Has_Vector_Scalar_Instructions then
Put_Line("Has VSI");
end if;
if Specifics.Has_Altivec_Additional_Registers then
Put_Line("Has VMX128");
end if;
if Specifics.Has_Altivec then
Put_Line("Has Altivec");
end if;
when Intel_Vendor | Advanced_Micro_Devices_Vendor =>
if Specifics.Vendor = Advanced_Micro_Devices_Vendor then
if Specifics.Has_3DNow then
Put_Line("Has 3DNow!");
end if;
if Specifics.Has_3DNow_Supplement then
Put_Line("Has 3DNow!+");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_4_Supplement then
Put_Line("Has SSE4a");
end if;
if Specifics.Has_Multi_Media_Extensions_Supplement then
Put_Line("Has MMX+");
end if;
end if;
if Specifics.Has_Multi_Media_Extensions then
Put_Line("Has MMX");
end if;
if Specifics.Has_Fused_Multiply_Add_3 then
Put_Line("Has FMA3");
end if;
if Specifics.Has_Fused_Multiply_Add_4 then
Put_Line("Has FMA4");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_1 then
Put_Line("Has SSE");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_2 then
Put_Line("Has SSE2");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_3 then
Put_Line("Has SSE3");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_3_Supplement then
Put_Line("Has SSSE3");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_4_1 then
Put_Line("Has SSE4.1");
end if;
if Specifics.Has_Streaming_SIMD_Extensions_4_2 then
Put_Line("Has SSE4.2");
end if;
if Specifics.Has_Bit_Manipulation_Extensions_1 then
Put_Line("Has BMI1");
end if;
if Specifics.Has_Bit_Manipulation_Extensions_2 then
Put_Line("Has BMI2");
end if;
if Specifics.Has_Advanced_Vector_Extensions_1 then
Put("Has AVX");
if not Specifics.Has_Advanced_Vector_Extensions_Enabled then
Put_Line(", but it's disabled");
else
New_Line;
end if;
end if;
if Specifics.Has_Advanced_Vector_Extensions_2 then
Put("Has AVX2");
if not Specifics.Has_Advanced_Vector_Extensions_Enabled then
if not Specifics.Has_Advanced_Vector_Extensions_1 then
Put_Line(", but it's disabled");
else
Put_Line(", but it's also disabled");
end if;
else
New_Line;
end if;
end if;
if Specifics.Has_Context_ID_Manager then
Put_Line("Has INVPCID");
end if;
if Specifics.Has_Population_Count then
Put_Line("Has POPCNT");
end if;
if Specifics.Has_Leading_Zero_Count then
Put_Line("Has LZCNT");
end if;
if Specifics.Has_Carryless_Multiplication_Of_Two_64_Bit then
Put_Line("Has PCLMULQDQ");
end if;
if Specifics.Has_Extended_States_Enabled then
Put_Line("Has OSXSAVE");
end if;
if Specifics.Has_Half_Precision_Floating_Point_Convert then
Put_Line("Has F16C");
end if;
if Specifics.Has_High_Precision_Convert then
Put_Line("Has CVT16");
end if;
if Specifics.Has_Advanced_Encryption_Service then
Put_Line("Has AES");
end if;
if Specifics.Has_Advanced_State_Operations then
Put_Line("Has FXSR");
end if;
if Specifics.Has_Extended_Operation_Support then
Put_Line("Has XOP");
end if;
if Specifics.Has_Hyperthreading then
Put_Line("Has HTT");
end if;
if Specifics.Has_Conditional_Move then
Put_Line("Has CMOV");
end if;
when OTHERS =>
null;
end case;
if Is_Stack_Empty then
Put_Line("Stack is empty!");
else
Put_Stack;
Clear_Stack;
if Is_Stack_Empty then
Put_Line("Stack was cleared successfully");
end if;
end if;
Put_Stack;
D;
Hang_Window;
exception
when Unsupported_Feature =>
Put_Line("Unsupported feature!");
Hang_Window;
end Test;
----------------
-- Initialize --
----------------
procedure Initialize
renames Implementation_For_Architecture.Initialize;
----------------------
-- Check_Exceptions --
----------------------
procedure Check_Exceptions
renames Implementation_For_Architecture.Check_Exceptions;
-----------------
-- Clear_Stack --
-----------------
procedure Clear_Stack
renames Implementation_For_Architecture.Clear_Stack;
--------------------
-- Is_Stack_Empty --
--------------------
function Is_Stack_Empty
return Boolean
renames Implementation_For_Architecture.Is_Stack_Empty;
------------------
-- Set_Rounding --
------------------
procedure Set_Rounding(
Rounding : in Enumerated_Rounding)
renames Implementation_For_Architecture.Set_Rounding;
-------------------
-- Set_Precision --
-------------------
procedure Set_Precision(
Precision : in Enumerated_Precision)
renames Implementation_For_Architecture.Set_Precision;
-------------------
-- Get_Specifics --
-------------------
function Get_Specifics
return Record_Specifics
renames Implementation_For_Architecture.Get_Specifics;
----------------
-- Get_Vendor --
----------------
function Get_Vendor
return Enumerated_Vendor
renames Implementation_For_Architecture.Get_Vendor;
--------------------
-- Get_Clock_Tics --
--------------------
function Get_Clock_Ticks
return Integer_8_Unsigned
is
begin
return Implementation_For_Operating_System.Get_Clock_Ticks;
exception
when Unsupported_Feature | System_Call_Failure =>
return Implementation_For_Architecture.Get_Clock_Ticks;
end Get_Clock_Ticks;
-------------------------
-- Get_Number_Of_Cores --
-------------------------
function Get_Number_Of_Cores
return Integer_8_Unsigned
is
begin
return Implementation_For_Operating_System.Get_Number_Of_Cores;
exception
when Unsupported_Feature | System_Call_Failure =>
-------------
Try_Assembly:
-------------
declare
begin
return Implementation_For_Architecture.Get_Number_Of_Cores;
exception
when Unsupported_Feature =>
return Integer_8_Unsigned(Number_Of_CPUs); -- How reliable is this?
end Try_Assembly;
end Get_Number_Of_Cores;
----------------------------
-- Get_Speed_In_Megahertz --
----------------------------
function Get_Speed_In_Megahertz
return Integer_8_Unsigned
is
begin
return Implementation_For_Operating_System.Get_Speed_In_Megahertz;
exception
when Unsupported_Feature | System_Call_Failure =>
---------------
Time_Processor:
---------------
declare
Start : Integer_8_Unsigned := 0;
begin
Start := Get_Clock_Ticks;
delay PROCESSOR_SPEED_TIMING_DELAY;
return (Get_Clock_Ticks - Start) * Integer_8_Unsigned(1.0 / PROCESSOR_SPEED_TIMING_DELAY);
end Time_Processor;
end Get_Speed_In_Megahertz;
---------------
-- Put_Stack --
---------------
procedure Put_Stack
renames Implementation_For_Architecture.Put_Stack;
---------------
-- Put_Trace --
---------------
procedure Put_Trace
is
begin
Put_Line("Trace:");
Implementation_For_Compiler.Put_Trace;
exception
when Unsupported_Feature | System_Call_Failure =>
Implementation_For_Architecture.Put_Trace;
end Put_Trace;
end Neo.System.Processor;