annotate gcc/ada/libgnat/s-pack09.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT RUN-TIME COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- S Y S T E M . P A C K _ 0 9 --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 with System.Storage_Elements;
kono
parents:
diff changeset
33 with System.Unsigned_Types;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 package body System.Pack_09 is
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 subtype Bit_Order is System.Bit_Order;
kono
parents:
diff changeset
38 Reverse_Bit_Order : constant Bit_Order :=
kono
parents:
diff changeset
39 Bit_Order'Val (1 - Bit_Order'Pos (System.Default_Bit_Order));
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 subtype Ofs is System.Storage_Elements.Storage_Offset;
kono
parents:
diff changeset
42 subtype Uns is System.Unsigned_Types.Unsigned;
kono
parents:
diff changeset
43 subtype N07 is System.Unsigned_Types.Unsigned range 0 .. 7;
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 use type System.Storage_Elements.Storage_Offset;
kono
parents:
diff changeset
46 use type System.Unsigned_Types.Unsigned;
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 type Cluster is record
kono
parents:
diff changeset
49 E0, E1, E2, E3, E4, E5, E6, E7 : Bits_09;
kono
parents:
diff changeset
50 end record;
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 for Cluster use record
kono
parents:
diff changeset
53 E0 at 0 range 0 * Bits .. 0 * Bits + Bits - 1;
kono
parents:
diff changeset
54 E1 at 0 range 1 * Bits .. 1 * Bits + Bits - 1;
kono
parents:
diff changeset
55 E2 at 0 range 2 * Bits .. 2 * Bits + Bits - 1;
kono
parents:
diff changeset
56 E3 at 0 range 3 * Bits .. 3 * Bits + Bits - 1;
kono
parents:
diff changeset
57 E4 at 0 range 4 * Bits .. 4 * Bits + Bits - 1;
kono
parents:
diff changeset
58 E5 at 0 range 5 * Bits .. 5 * Bits + Bits - 1;
kono
parents:
diff changeset
59 E6 at 0 range 6 * Bits .. 6 * Bits + Bits - 1;
kono
parents:
diff changeset
60 E7 at 0 range 7 * Bits .. 7 * Bits + Bits - 1;
kono
parents:
diff changeset
61 end record;
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 for Cluster'Size use Bits * 8;
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 for Cluster'Alignment use Integer'Min (Standard'Maximum_Alignment,
kono
parents:
diff changeset
66 1 +
kono
parents:
diff changeset
67 1 * Boolean'Pos (Bits mod 2 = 0) +
kono
parents:
diff changeset
68 2 * Boolean'Pos (Bits mod 4 = 0));
kono
parents:
diff changeset
69 -- Use maximum possible alignment, given the bit field size, since this
kono
parents:
diff changeset
70 -- will result in the most efficient code possible for the field.
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 type Cluster_Ref is access Cluster;
kono
parents:
diff changeset
73
kono
parents:
diff changeset
74 type Rev_Cluster is new Cluster
kono
parents:
diff changeset
75 with Bit_Order => Reverse_Bit_Order,
kono
parents:
diff changeset
76 Scalar_Storage_Order => Reverse_Bit_Order;
kono
parents:
diff changeset
77 type Rev_Cluster_Ref is access Rev_Cluster;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 ------------
kono
parents:
diff changeset
80 -- Get_09 --
kono
parents:
diff changeset
81 ------------
kono
parents:
diff changeset
82
kono
parents:
diff changeset
83 function Get_09
kono
parents:
diff changeset
84 (Arr : System.Address;
kono
parents:
diff changeset
85 N : Natural;
kono
parents:
diff changeset
86 Rev_SSO : Boolean) return Bits_09
kono
parents:
diff changeset
87 is
kono
parents:
diff changeset
88 A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
kono
parents:
diff changeset
89 C : Cluster_Ref with Address => A'Address, Import;
kono
parents:
diff changeset
90 RC : Rev_Cluster_Ref with Address => A'Address, Import;
kono
parents:
diff changeset
91 begin
kono
parents:
diff changeset
92 if Rev_SSO then
kono
parents:
diff changeset
93 case N07 (Uns (N) mod 8) is
kono
parents:
diff changeset
94 when 0 => return RC.E0;
kono
parents:
diff changeset
95 when 1 => return RC.E1;
kono
parents:
diff changeset
96 when 2 => return RC.E2;
kono
parents:
diff changeset
97 when 3 => return RC.E3;
kono
parents:
diff changeset
98 when 4 => return RC.E4;
kono
parents:
diff changeset
99 when 5 => return RC.E5;
kono
parents:
diff changeset
100 when 6 => return RC.E6;
kono
parents:
diff changeset
101 when 7 => return RC.E7;
kono
parents:
diff changeset
102 end case;
kono
parents:
diff changeset
103
kono
parents:
diff changeset
104 else
kono
parents:
diff changeset
105 case N07 (Uns (N) mod 8) is
kono
parents:
diff changeset
106 when 0 => return C.E0;
kono
parents:
diff changeset
107 when 1 => return C.E1;
kono
parents:
diff changeset
108 when 2 => return C.E2;
kono
parents:
diff changeset
109 when 3 => return C.E3;
kono
parents:
diff changeset
110 when 4 => return C.E4;
kono
parents:
diff changeset
111 when 5 => return C.E5;
kono
parents:
diff changeset
112 when 6 => return C.E6;
kono
parents:
diff changeset
113 when 7 => return C.E7;
kono
parents:
diff changeset
114 end case;
kono
parents:
diff changeset
115 end if;
kono
parents:
diff changeset
116 end Get_09;
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 ------------
kono
parents:
diff changeset
119 -- Set_09 --
kono
parents:
diff changeset
120 ------------
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 procedure Set_09
kono
parents:
diff changeset
123 (Arr : System.Address;
kono
parents:
diff changeset
124 N : Natural;
kono
parents:
diff changeset
125 E : Bits_09;
kono
parents:
diff changeset
126 Rev_SSO : Boolean)
kono
parents:
diff changeset
127 is
kono
parents:
diff changeset
128 A : constant System.Address := Arr + Bits * Ofs (Uns (N) / 8);
kono
parents:
diff changeset
129 C : Cluster_Ref with Address => A'Address, Import;
kono
parents:
diff changeset
130 RC : Rev_Cluster_Ref with Address => A'Address, Import;
kono
parents:
diff changeset
131 begin
kono
parents:
diff changeset
132 if Rev_SSO then
kono
parents:
diff changeset
133 case N07 (Uns (N) mod 8) is
kono
parents:
diff changeset
134 when 0 => RC.E0 := E;
kono
parents:
diff changeset
135 when 1 => RC.E1 := E;
kono
parents:
diff changeset
136 when 2 => RC.E2 := E;
kono
parents:
diff changeset
137 when 3 => RC.E3 := E;
kono
parents:
diff changeset
138 when 4 => RC.E4 := E;
kono
parents:
diff changeset
139 when 5 => RC.E5 := E;
kono
parents:
diff changeset
140 when 6 => RC.E6 := E;
kono
parents:
diff changeset
141 when 7 => RC.E7 := E;
kono
parents:
diff changeset
142 end case;
kono
parents:
diff changeset
143 else
kono
parents:
diff changeset
144 case N07 (Uns (N) mod 8) is
kono
parents:
diff changeset
145 when 0 => C.E0 := E;
kono
parents:
diff changeset
146 when 1 => C.E1 := E;
kono
parents:
diff changeset
147 when 2 => C.E2 := E;
kono
parents:
diff changeset
148 when 3 => C.E3 := E;
kono
parents:
diff changeset
149 when 4 => C.E4 := E;
kono
parents:
diff changeset
150 when 5 => C.E5 := E;
kono
parents:
diff changeset
151 when 6 => C.E6 := E;
kono
parents:
diff changeset
152 when 7 => C.E7 := E;
kono
parents:
diff changeset
153 end case;
kono
parents:
diff changeset
154 end if;
kono
parents:
diff changeset
155 end Set_09;
kono
parents:
diff changeset
156
kono
parents:
diff changeset
157 end System.Pack_09;