gcc/ada/g-bytswa-x86.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                    G N A T . B Y T E _ S W A P P I N G                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2006-2007, AdaCore                     --
  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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  This is a machine-specific version of this package.
  35 --  It uses instructions available on Intel 486 processors (or later).
  36
  37 with Interfaces;          use Interfaces;
  38 with System.Machine_Code; use System.Machine_Code;
  39 with Ada.Unchecked_Conversion;
  40
  41 package body GNAT.Byte_Swapping is
  42
  43    -----------------------
  44    -- Local Subprograms --
  45    -----------------------
  46
  47    function Swapped32 (Value : Unsigned_32) return Unsigned_32;
  48    pragma Inline_Always (Swapped32);
  49
  50    --------------
  51    -- Swapped2 --
  52    --------------
  53
  54    function Swapped2 (Input : Item) return Item is
  55
  56       function As_U16 is new Ada.Unchecked_Conversion
  57          (Source => Item, Target => Unsigned_16);
  58
  59       function As_Item is new Ada.Unchecked_Conversion
  60          (Source => Unsigned_16, Target => Item);
  61
  62       X : Unsigned_16 := As_U16 (Input);
  63
  64    begin
  65       Asm ("xchgb %b0,%h0",
  66            Unsigned_16'Asm_Output ("=q", X),
  67            Unsigned_16'Asm_Input ("0", X));
  68       return As_Item (X);
  69    end Swapped2;
  70
  71    --------------
  72    -- Swapped4 --
  73    --------------
  74
  75    function Swapped4 (Input : Item) return Item is
  76
  77       function As_U32 is new Ada.Unchecked_Conversion
  78          (Source => Item, Target => Unsigned_32);
  79
  80       function As_Item is new Ada.Unchecked_Conversion
  81          (Source => Unsigned_32, Target => Item);
  82
  83       X : Unsigned_32 := As_U32 (Input);
  84
  85    begin
  86       Asm ("bswap %0",
  87            Unsigned_32'Asm_Output ("=r", X),
  88            Unsigned_32'Asm_Input ("0", X));
  89       return As_Item (X);
  90    end Swapped4;
  91
  92    --------------
  93    -- Swapped8 --
  94    --------------
  95
  96    function Swapped8 (Input : Item) return Item is
  97
  98       function As_U64 is new Ada.Unchecked_Conversion
  99          (Source => Item, Target => Unsigned_64);
 100
 101       X : constant Unsigned_64 := As_U64 (Input);
 102
 103       type Two_Words is array (0 .. 1) of Unsigned_32;
 104       for Two_Words'Component_Size use Unsigned_32'Size;
 105
 106       function As_Item is new Ada.Unchecked_Conversion
 107         (Source => Two_Words, Target => Item);
 108
 109       Result : Two_Words;
 110
 111    begin
 112       Asm ("xchgl %0,%1",
 113          Outputs =>
 114             (Unsigned_32'Asm_Output ("=r", Result (0)),
 115              Unsigned_32'Asm_Output ("=r", Result (1))),
 116          Inputs =>
 117             (Unsigned_32'Asm_Input ("0",
 118                 Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))),
 119              Unsigned_32'Asm_Input ("1",
 120                 Swapped32 (Unsigned_32 (Shift_Right (X, 32))))));
 121       return As_Item (Result);
 122    end Swapped8;
 123
 124    -----------
 125    -- Swap2 --
 126    -----------
 127
 128    procedure Swap2 (Location : System.Address) is
 129
 130       X : Unsigned_16;
 131       for X'Address use Location;
 132
 133    begin
 134       Asm ("xchgb %b0,%h0",
 135            Unsigned_16'Asm_Output ("=q", X),
 136            Unsigned_16'Asm_Input ("0", X));
 137    end Swap2;
 138
 139    -----------
 140    -- Swap4 --
 141    -----------
 142
 143    procedure Swap4 (Location : System.Address) is
 144
 145       X : Unsigned_32;
 146       for X'Address use Location;
 147
 148    begin
 149       Asm ("bswap %0",
 150            Unsigned_32'Asm_Output ("=r", X),
 151            Unsigned_32'Asm_Input ("0", X));
 152    end Swap4;
 153
 154    ---------------
 155    -- Swapped32 --
 156    ---------------
 157
 158    function Swapped32 (Value : Unsigned_32) return Unsigned_32 is
 159       X : Unsigned_32 := Value;
 160    begin
 161       Asm ("bswap %0",
 162            Unsigned_32'Asm_Output ("=r", X),
 163            Unsigned_32'Asm_Input ("0", X));
 164       return X;
 165    end Swapped32;
 166
 167    -----------
 168    -- Swap8 --
 169    -----------
 170
 171    procedure Swap8 (Location : System.Address) is
 172
 173       X : Unsigned_64;
 174       for X'Address use Location;
 175
 176       type Two_Words is array (0 .. 1) of Unsigned_32;
 177       for Two_Words'Component_Size use Unsigned_32'Size;
 178
 179       Words : Two_Words;
 180       for Words'Address use Location;
 181
 182    begin
 183       Asm ("xchgl %0,%1",
 184          Outputs =>
 185             (Unsigned_32'Asm_Output ("=r", Words (0)),
 186              Unsigned_32'Asm_Output ("=r", Words (1))),
 187          Inputs =>
 188             (Unsigned_32'Asm_Input ("0",
 189                 Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))),
 190              Unsigned_32'Asm_Input ("1",
 191                 Swapped32 (Unsigned_32 (Shift_Right (X, 32))))));
 192    end Swap8;
 193
 194 end GNAT.Byte_Swapping;