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-2020, 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
32with Ada.Unchecked_Conversion;
33
34with System; use System;
35
36package 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
514end GNAT.Altivec.Conversions;
515