GCC v8.2
[gcc.git] / gcc / ada / libgnat / 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-2018, 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 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception,   --
20 -- version 3.1, as published by the Free Software Foundation.               --
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;