File : g-altcon.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T . A L T I V E C . C O N V E R S I O N S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Unchecked_Conversion;
33
34 with System; use System;
35
36 package body GNAT.Altivec.Conversions is
37
38 -- All the vector/view conversions operate similarly: bare unchecked
39 -- conversion on big endian targets, and elements permutation on little
40 -- endian targets. We call "Mirroring" the elements permutation process.
41
42 -- We would like to provide a generic version of the conversion routines
43 -- and just have a set of "renaming as body" declarations to satisfy the
44 -- public interface. This unfortunately prevents inlining, which we must
45 -- preserve at least for the hard binding.
46
47 -- We instead provide a generic version of facilities needed by all the
48 -- conversion routines and use them repeatedly.
49
50 generic
51 type Vitem_Type is private;
52
53 type Varray_Index_Type is range <>;
54 type Varray_Type is array (Varray_Index_Type) of Vitem_Type;
55
56 type Vector_Type is private;
57 type View_Type is private;
58
59 package Generic_Conversions is
60
61 subtype Varray is Varray_Type;
62 -- This provides an easy common way to refer to the type parameter
63 -- in contexts where a specific instance of this package is "use"d.
64
65 procedure Mirror (A : Varray_Type; Into : out Varray_Type);
66 pragma Inline (Mirror);
67 -- Mirror the elements of A into INTO, not touching the per-element
68 -- internal ordering.
69
70 -- A procedure with an out parameter is a bit heavier to use than a
71 -- function but reduces the amount of temporary creations around the
72 -- call. Instances are typically not front-end inlined. They can still
73 -- be back-end inlined on request with the proper command-line option.
74
75 -- Below are Unchecked Conversion routines for various purposes,
76 -- relying on internal knowledge about the bits layout in the different
77 -- types (all 128 value bits blocks).
78
79 -- View<->Vector straight bitwise conversions on BE targets
80
81 function UNC_To_Vector is
82 new Ada.Unchecked_Conversion (View_Type, Vector_Type);
83
84 function UNC_To_View is
85 new Ada.Unchecked_Conversion (Vector_Type, View_Type);
86
87 -- Varray->Vector/View for returning mirrored results on LE targets
88
89 function UNC_To_Vector is
90 new Ada.Unchecked_Conversion (Varray_Type, Vector_Type);
91
92 function UNC_To_View is
93 new Ada.Unchecked_Conversion (Varray_Type, View_Type);
94
95 -- Vector/View->Varray for to-be-permuted source on LE targets
96
97 function UNC_To_Varray is
98 new Ada.Unchecked_Conversion (Vector_Type, Varray_Type);
99
100 function UNC_To_Varray is
101 new Ada.Unchecked_Conversion (View_Type, Varray_Type);
102
103 end Generic_Conversions;
104
105 package body Generic_Conversions is
106
107 procedure Mirror (A : Varray_Type; Into : out Varray_Type) is
108 begin
109 for J in A'Range loop
110 Into (J) := A (A'Last - J + A'First);
111 end loop;
112 end Mirror;
113
114 end Generic_Conversions;
115
116 -- Now we declare the instances and implement the interface function
117 -- bodies simply calling the instantiated routines.
118
119 ---------------------
120 -- Char components --
121 ---------------------
122
123 package SC_Conversions is new Generic_Conversions
124 (signed_char, Vchar_Range, Varray_signed_char, VSC, VSC_View);
125
126 function To_Vector (S : VSC_View) return VSC is
127 use SC_Conversions;
128 begin
129 if Default_Bit_Order = High_Order_First then
130 return UNC_To_Vector (S);
131 else
132 declare
133 M : Varray;
134 begin
135 Mirror (UNC_To_Varray (S), Into => M);
136 return UNC_To_Vector (M);
137 end;
138 end if;
139 end To_Vector;
140
141 function To_View (S : VSC) return VSC_View is
142 use SC_Conversions;
143 begin
144 if Default_Bit_Order = High_Order_First then
145 return UNC_To_View (S);
146 else
147 declare
148 M : Varray;
149 begin
150 Mirror (UNC_To_Varray (S), Into => M);
151 return UNC_To_View (M);
152 end;
153 end if;
154 end To_View;
155
156 --
157
158 package UC_Conversions is new Generic_Conversions
159 (unsigned_char, Vchar_Range, Varray_unsigned_char, VUC, VUC_View);
160
161 function To_Vector (S : VUC_View) return VUC is
162 use UC_Conversions;
163 begin
164 if Default_Bit_Order = High_Order_First then
165 return UNC_To_Vector (S);
166 else
167 declare
168 M : Varray;
169 begin
170 Mirror (UNC_To_Varray (S), Into => M);
171 return UNC_To_Vector (M);
172 end;
173 end if;
174 end To_Vector;
175
176 function To_View (S : VUC) return VUC_View is
177 use UC_Conversions;
178 begin
179 if Default_Bit_Order = High_Order_First then
180 return UNC_To_View (S);
181 else
182 declare
183 M : Varray;
184 begin
185 Mirror (UNC_To_Varray (S), Into => M);
186 return UNC_To_View (M);
187 end;
188 end if;
189 end To_View;
190
191 --
192
193 package BC_Conversions is new Generic_Conversions
194 (bool_char, Vchar_Range, Varray_bool_char, VBC, VBC_View);
195
196 function To_Vector (S : VBC_View) return VBC is
197 use BC_Conversions;
198 begin
199 if Default_Bit_Order = High_Order_First then
200 return UNC_To_Vector (S);
201 else
202 declare
203 M : Varray;
204 begin
205 Mirror (UNC_To_Varray (S), Into => M);
206 return UNC_To_Vector (M);
207 end;
208 end if;
209 end To_Vector;
210
211 function To_View (S : VBC) return VBC_View is
212 use BC_Conversions;
213 begin
214 if Default_Bit_Order = High_Order_First then
215 return UNC_To_View (S);
216 else
217 declare
218 M : Varray;
219 begin
220 Mirror (UNC_To_Varray (S), Into => M);
221 return UNC_To_View (M);
222 end;
223 end if;
224 end To_View;
225
226 ----------------------
227 -- Short components --
228 ----------------------
229
230 package SS_Conversions is new Generic_Conversions
231 (signed_short, Vshort_Range, Varray_signed_short, VSS, VSS_View);
232
233 function To_Vector (S : VSS_View) return VSS is
234 use SS_Conversions;
235 begin
236 if Default_Bit_Order = High_Order_First then
237 return UNC_To_Vector (S);
238 else
239 declare
240 M : Varray;
241 begin
242 Mirror (UNC_To_Varray (S), Into => M);
243 return UNC_To_Vector (M);
244 end;
245 end if;
246 end To_Vector;
247
248 function To_View (S : VSS) return VSS_View is
249 use SS_Conversions;
250 begin
251 if Default_Bit_Order = High_Order_First then
252 return UNC_To_View (S);
253 else
254 declare
255 M : Varray;
256 begin
257 Mirror (UNC_To_Varray (S), Into => M);
258 return UNC_To_View (M);
259 end;
260 end if;
261 end To_View;
262
263 --
264
265 package US_Conversions is new Generic_Conversions
266 (unsigned_short, Vshort_Range, Varray_unsigned_short, VUS, VUS_View);
267
268 function To_Vector (S : VUS_View) return VUS is
269 use US_Conversions;
270 begin
271 if Default_Bit_Order = High_Order_First then
272 return UNC_To_Vector (S);
273 else
274 declare
275 M : Varray;
276 begin
277 Mirror (UNC_To_Varray (S), Into => M);
278 return UNC_To_Vector (M);
279 end;
280 end if;
281 end To_Vector;
282
283 function To_View (S : VUS) return VUS_View is
284 use US_Conversions;
285 begin
286 if Default_Bit_Order = High_Order_First then
287 return UNC_To_View (S);
288 else
289 declare
290 M : Varray;
291 begin
292 Mirror (UNC_To_Varray (S), Into => M);
293 return UNC_To_View (M);
294 end;
295 end if;
296 end To_View;
297
298 --
299
300 package BS_Conversions is new Generic_Conversions
301 (bool_short, Vshort_Range, Varray_bool_short, VBS, VBS_View);
302
303 function To_Vector (S : VBS_View) return VBS is
304 use BS_Conversions;
305 begin
306 if Default_Bit_Order = High_Order_First then
307 return UNC_To_Vector (S);
308 else
309 declare
310 M : Varray;
311 begin
312 Mirror (UNC_To_Varray (S), Into => M);
313 return UNC_To_Vector (M);
314 end;
315 end if;
316 end To_Vector;
317
318 function To_View (S : VBS) return VBS_View is
319 use BS_Conversions;
320 begin
321 if Default_Bit_Order = High_Order_First then
322 return UNC_To_View (S);
323 else
324 declare
325 M : Varray;
326 begin
327 Mirror (UNC_To_Varray (S), Into => M);
328 return UNC_To_View (M);
329 end;
330 end if;
331 end To_View;
332
333 --------------------
334 -- Int components --
335 --------------------
336
337 package SI_Conversions is new Generic_Conversions
338 (signed_int, Vint_Range, Varray_signed_int, VSI, VSI_View);
339
340 function To_Vector (S : VSI_View) return VSI is
341 use SI_Conversions;
342 begin
343 if Default_Bit_Order = High_Order_First then
344 return UNC_To_Vector (S);
345 else
346 declare
347 M : Varray;
348 begin
349 Mirror (UNC_To_Varray (S), Into => M);
350 return UNC_To_Vector (M);
351 end;
352 end if;
353 end To_Vector;
354
355 function To_View (S : VSI) return VSI_View is
356 use SI_Conversions;
357 begin
358 if Default_Bit_Order = High_Order_First then
359 return UNC_To_View (S);
360 else
361 declare
362 M : Varray;
363 begin
364 Mirror (UNC_To_Varray (S), Into => M);
365 return UNC_To_View (M);
366 end;
367 end if;
368 end To_View;
369
370 --
371
372 package UI_Conversions is new Generic_Conversions
373 (unsigned_int, Vint_Range, Varray_unsigned_int, VUI, VUI_View);
374
375 function To_Vector (S : VUI_View) return VUI is
376 use UI_Conversions;
377 begin
378 if Default_Bit_Order = High_Order_First then
379 return UNC_To_Vector (S);
380 else
381 declare
382 M : Varray;
383 begin
384 Mirror (UNC_To_Varray (S), Into => M);
385 return UNC_To_Vector (M);
386 end;
387 end if;
388 end To_Vector;
389
390 function To_View (S : VUI) return VUI_View is
391 use UI_Conversions;
392 begin
393 if Default_Bit_Order = High_Order_First then
394 return UNC_To_View (S);
395 else
396 declare
397 M : Varray;
398 begin
399 Mirror (UNC_To_Varray (S), Into => M);
400 return UNC_To_View (M);
401 end;
402 end if;
403 end To_View;
404
405 --
406
407 package BI_Conversions is new Generic_Conversions
408 (bool_int, Vint_Range, Varray_bool_int, VBI, VBI_View);
409
410 function To_Vector (S : VBI_View) return VBI is
411 use BI_Conversions;
412 begin
413 if Default_Bit_Order = High_Order_First then
414 return UNC_To_Vector (S);
415 else
416 declare
417 M : Varray;
418 begin
419 Mirror (UNC_To_Varray (S), Into => M);
420 return UNC_To_Vector (M);
421 end;
422 end if;
423 end To_Vector;
424
425 function To_View (S : VBI) return VBI_View is
426 use BI_Conversions;
427 begin
428 if Default_Bit_Order = High_Order_First then
429 return UNC_To_View (S);
430 else
431 declare
432 M : Varray;
433 begin
434 Mirror (UNC_To_Varray (S), Into => M);
435 return UNC_To_View (M);
436 end;
437 end if;
438 end To_View;
439
440 ----------------------
441 -- Float components --
442 ----------------------
443
444 package F_Conversions is new Generic_Conversions
445 (C_float, Vfloat_Range, Varray_float, VF, VF_View);
446
447 function To_Vector (S : VF_View) return VF is
448 use F_Conversions;
449 begin
450 if Default_Bit_Order = High_Order_First then
451 return UNC_To_Vector (S);
452 else
453 declare
454 M : Varray;
455 begin
456 Mirror (UNC_To_Varray (S), Into => M);
457 return UNC_To_Vector (M);
458 end;
459 end if;
460 end To_Vector;
461
462 function To_View (S : VF) return VF_View is
463 use F_Conversions;
464 begin
465 if Default_Bit_Order = High_Order_First then
466 return UNC_To_View (S);
467 else
468 declare
469 M : Varray;
470 begin
471 Mirror (UNC_To_Varray (S), Into => M);
472 return UNC_To_View (M);
473 end;
474 end if;
475 end To_View;
476
477 ----------------------
478 -- Pixel components --
479 ----------------------
480
481 package P_Conversions is new Generic_Conversions
482 (pixel, Vpixel_Range, Varray_pixel, VP, VP_View);
483
484 function To_Vector (S : VP_View) return VP is
485 use P_Conversions;
486 begin
487 if Default_Bit_Order = High_Order_First then
488 return UNC_To_Vector (S);
489 else
490 declare
491 M : Varray;
492 begin
493 Mirror (UNC_To_Varray (S), Into => M);
494 return UNC_To_Vector (M);
495 end;
496 end if;
497 end To_Vector;
498
499 function To_View (S : VP) return VP_View is
500 use P_Conversions;
501 begin
502 if Default_Bit_Order = High_Order_First then
503 return UNC_To_View (S);
504 else
505 declare
506 M : Varray;
507 begin
508 Mirror (UNC_To_Varray (S), Into => M);
509 return UNC_To_View (M);
510 end;
511 end if;
512 end To_View;
513
514 end GNAT.Altivec.Conversions;