OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [ada/] [g-bytswa.adb] - Blame information for rev 516

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
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 general implementation that does not take advantage of
35
--  any machine-specific instructions.
36
 
37
with Interfaces; use Interfaces;
38
with Ada.Unchecked_Conversion;
39
 
40
package body GNAT.Byte_Swapping is
41
 
42
   --------------
43
   -- Swapped2 --
44
   --------------
45
 
46
   function Swapped2 (Input : Item) return Item is
47
 
48
      function As_U16 is new Ada.Unchecked_Conversion
49
         (Source => Item, Target => Unsigned_16);
50
 
51
      function As_Item is new Ada.Unchecked_Conversion
52
         (Source => Unsigned_16, Target => Item);
53
 
54
      X : constant Unsigned_16 := As_U16 (Input);
55
 
56
   begin
57
      return As_Item ((Shift_Left (X, 8)  and 16#FF00#) or
58
                      (Shift_Right (X, 8) and 16#00FF#));
59
   end Swapped2;
60
 
61
   --------------
62
   -- Swapped4 --
63
   --------------
64
 
65
   function Swapped4 (Input : Item) return Item is
66
 
67
      function As_U32 is new Ada.Unchecked_Conversion
68
         (Source => Item, Target => Unsigned_32);
69
 
70
      function As_Item is new Ada.Unchecked_Conversion
71
         (Source => Unsigned_32, Target => Item);
72
 
73
      X : constant Unsigned_32 := As_U32 (Input);
74
 
75
   begin
76
      return As_Item ((Shift_Right (X, 24) and 16#0000_00FF#) or
77
                      (Shift_Right (X, 8)  and 16#0000_FF00#) or
78
                      (Shift_Left (X, 8)   and 16#00FF_0000#) or
79
                      (Shift_Left (X, 24)  and 16#FF00_0000#));
80
   end Swapped4;
81
 
82
   --------------
83
   -- Swapped8 --
84
   --------------
85
 
86
   function Swapped8 (Input : Item) return Item is
87
 
88
      function As_U64 is new Ada.Unchecked_Conversion
89
         (Source => Item, Target => Unsigned_64);
90
 
91
      function As_Item is new Ada.Unchecked_Conversion
92
         (Source => Unsigned_64, Target => Item);
93
 
94
      X : constant Unsigned_64 := As_U64 (Input);
95
 
96
      Low, High : aliased Unsigned_32;
97
 
98
   begin
99
      Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#);
100
      Swap4 (Low'Address);
101
      High := Unsigned_32 (Shift_Right (X, 32));
102
      Swap4 (High'Address);
103
      return As_Item
104
         (Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High));
105
   end Swapped8;
106
 
107
   -----------
108
   -- Swap2 --
109
   -----------
110
 
111
   procedure Swap2 (Location : System.Address) is
112
      X : Unsigned_16;
113
      for X'Address use Location;
114
   begin
115
      X := (Shift_Left (X, 8)  and 16#FF00#) or
116
           (Shift_Right (X, 8) and 16#00FF#);
117
   end Swap2;
118
 
119
   -----------
120
   -- Swap4 --
121
   -----------
122
 
123
   procedure Swap4 (Location : System.Address) is
124
      X : Unsigned_32;
125
      for X'Address use Location;
126
   begin
127
      X := (Shift_Right (X, 24) and 16#0000_00FF#) or
128
           (Shift_Right (X, 8)  and 16#0000_FF00#) or
129
           (Shift_Left (X, 8)   and 16#00FF_0000#) or
130
           (Shift_Left (X, 24)  and 16#FF00_0000#);
131
   end Swap4;
132
 
133
   -----------
134
   -- Swap8 --
135
   -----------
136
 
137
   procedure Swap8 (Location : System.Address) is
138
      X : Unsigned_64;
139
      for X'Address use Location;
140
 
141
      Low, High : aliased Unsigned_32;
142
 
143
   begin
144
      Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#);
145
      Swap4 (Low'Address);
146
      High := Unsigned_32 (Shift_Right (X, 32));
147
      Swap4 (High'Address);
148
      X := Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High);
149
   end Swap8;
150
 
151
end GNAT.Byte_Swapping;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.