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-- 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