(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_1_Bit
is
-- We wish we were using packed arrays, but instead we're simulating
- -- packed arrays using packed records. L here (and elsewhere) is the
- -- 'Length of that array.
- L : constant Field_Offset := 32;
+ -- them with modular integers. L here (and elsewhere) is the 'Length
+ -- of that simulated array.
+ L : constant Field_Offset := Slot_Size / 1;
pragma Debug (Validate_Node_And_Offset (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => return S.Slot_1.F0;
- when 1 => return S.Slot_1.F1;
- when 2 => return S.Slot_1.F2;
- when 3 => return S.Slot_1.F3;
- when 4 => return S.Slot_1.F4;
- when 5 => return S.Slot_1.F5;
- when 6 => return S.Slot_1.F6;
- when 7 => return S.Slot_1.F7;
- when 8 => return S.Slot_1.F8;
- when 9 => return S.Slot_1.F9;
- when 10 => return S.Slot_1.F10;
- when 11 => return S.Slot_1.F11;
- when 12 => return S.Slot_1.F12;
- when 13 => return S.Slot_1.F13;
- when 14 => return S.Slot_1.F14;
- when 15 => return S.Slot_1.F15;
- when 16 => return S.Slot_1.F16;
- when 17 => return S.Slot_1.F17;
- when 18 => return S.Slot_1.F18;
- when 19 => return S.Slot_1.F19;
- when 20 => return S.Slot_1.F20;
- when 21 => return S.Slot_1.F21;
- when 22 => return S.Slot_1.F22;
- when 23 => return S.Slot_1.F23;
- when 24 => return S.Slot_1.F24;
- when 25 => return S.Slot_1.F25;
- when 26 => return S.Slot_1.F26;
- when 27 => return S.Slot_1.F27;
- when 28 => return S.Slot_1.F28;
- when 29 => return S.Slot_1.F29;
- when 30 => return S.Slot_1.F30;
- when 31 => return S.Slot_1.F31;
- end case;
+ return Field_1_Bit (Shift_Right (S, V) and 1);
end Get_1_Bit_Val;
function Get_2_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_2_Bit
is
- L : constant Field_Offset := 16;
+ L : constant Field_Offset := Slot_Size / 2;
pragma Debug (Validate_Node_And_Offset (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => return S.Slot_2.F0;
- when 1 => return S.Slot_2.F1;
- when 2 => return S.Slot_2.F2;
- when 3 => return S.Slot_2.F3;
- when 4 => return S.Slot_2.F4;
- when 5 => return S.Slot_2.F5;
- when 6 => return S.Slot_2.F6;
- when 7 => return S.Slot_2.F7;
- when 8 => return S.Slot_2.F8;
- when 9 => return S.Slot_2.F9;
- when 10 => return S.Slot_2.F10;
- when 11 => return S.Slot_2.F11;
- when 12 => return S.Slot_2.F12;
- when 13 => return S.Slot_2.F13;
- when 14 => return S.Slot_2.F14;
- when 15 => return S.Slot_2.F15;
- end case;
+ return Field_2_Bit (Shift_Right (S, V) and 3);
end Get_2_Bit_Val;
function Get_4_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_4_Bit
is
- L : constant Field_Offset := 8;
+ L : constant Field_Offset := Slot_Size / 4;
pragma Debug (Validate_Node_And_Offset (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => return S.Slot_4.F0;
- when 1 => return S.Slot_4.F1;
- when 2 => return S.Slot_4.F2;
- when 3 => return S.Slot_4.F3;
- when 4 => return S.Slot_4.F4;
- when 5 => return S.Slot_4.F5;
- when 6 => return S.Slot_4.F6;
- when 7 => return S.Slot_4.F7;
- end case;
+ return Field_4_Bit (Shift_Right (S, V) and 15);
end Get_4_Bit_Val;
function Get_8_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit
is
- L : constant Field_Offset := 4;
+ L : constant Field_Offset := Slot_Size / 8;
pragma Debug (Validate_Node_And_Offset (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => return S.Slot_8.F0;
- when 1 => return S.Slot_8.F1;
- when 2 => return S.Slot_8.F2;
- when 3 => return S.Slot_8.F3;
- end case;
+ return Field_8_Bit (Shift_Right (S, V) and 255);
end Get_8_Bit_Val;
function Get_32_Bit_Val
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset);
begin
- return S.Slot_32;
+ return Field_32_Bit (S);
end Get_32_Bit_Val;
procedure Set_1_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_1_Bit)
is
- L : constant Field_Offset := 32;
+ L : constant Field_Offset := Slot_Size / 1;
pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => S.Slot_1.F0 := Val;
- when 1 => S.Slot_1.F1 := Val;
- when 2 => S.Slot_1.F2 := Val;
- when 3 => S.Slot_1.F3 := Val;
- when 4 => S.Slot_1.F4 := Val;
- when 5 => S.Slot_1.F5 := Val;
- when 6 => S.Slot_1.F6 := Val;
- when 7 => S.Slot_1.F7 := Val;
- when 8 => S.Slot_1.F8 := Val;
- when 9 => S.Slot_1.F9 := Val;
- when 10 => S.Slot_1.F10 := Val;
- when 11 => S.Slot_1.F11 := Val;
- when 12 => S.Slot_1.F12 := Val;
- when 13 => S.Slot_1.F13 := Val;
- when 14 => S.Slot_1.F14 := Val;
- when 15 => S.Slot_1.F15 := Val;
- when 16 => S.Slot_1.F16 := Val;
- when 17 => S.Slot_1.F17 := Val;
- when 18 => S.Slot_1.F18 := Val;
- when 19 => S.Slot_1.F19 := Val;
- when 20 => S.Slot_1.F20 := Val;
- when 21 => S.Slot_1.F21 := Val;
- when 22 => S.Slot_1.F22 := Val;
- when 23 => S.Slot_1.F23 := Val;
- when 24 => S.Slot_1.F24 := Val;
- when 25 => S.Slot_1.F25 := Val;
- when 26 => S.Slot_1.F26 := Val;
- when 27 => S.Slot_1.F27 := Val;
- when 28 => S.Slot_1.F28 := Val;
- when 29 => S.Slot_1.F29 := Val;
- when 30 => S.Slot_1.F30 := Val;
- when 31 => S.Slot_1.F31 := Val;
- end case;
+ S := (S and not Shift_Left (1, V)) or Shift_Left (Slot (Val), V);
end Set_1_Bit_Val;
procedure Set_2_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_2_Bit)
is
- L : constant Field_Offset := 16;
+ L : constant Field_Offset := Slot_Size / 2;
pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => S.Slot_2.F0 := Val;
- when 1 => S.Slot_2.F1 := Val;
- when 2 => S.Slot_2.F2 := Val;
- when 3 => S.Slot_2.F3 := Val;
- when 4 => S.Slot_2.F4 := Val;
- when 5 => S.Slot_2.F5 := Val;
- when 6 => S.Slot_2.F6 := Val;
- when 7 => S.Slot_2.F7 := Val;
- when 8 => S.Slot_2.F8 := Val;
- when 9 => S.Slot_2.F9 := Val;
- when 10 => S.Slot_2.F10 := Val;
- when 11 => S.Slot_2.F11 := Val;
- when 12 => S.Slot_2.F12 := Val;
- when 13 => S.Slot_2.F13 := Val;
- when 14 => S.Slot_2.F14 := Val;
- when 15 => S.Slot_2.F15 := Val;
- end case;
+ S := (S and not Shift_Left (3, V)) or Shift_Left (Slot (Val), V);
end Set_2_Bit_Val;
procedure Set_4_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_4_Bit)
is
- L : constant Field_Offset := 8;
+ L : constant Field_Offset := Slot_Size / 4;
pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => S.Slot_4.F0 := Val;
- when 1 => S.Slot_4.F1 := Val;
- when 2 => S.Slot_4.F2 := Val;
- when 3 => S.Slot_4.F3 := Val;
- when 4 => S.Slot_4.F4 := Val;
- when 5 => S.Slot_4.F5 := Val;
- when 6 => S.Slot_4.F6 := Val;
- when 7 => S.Slot_4.F7 := Val;
- end case;
+ S := (S and not Shift_Left (15, V)) or Shift_Left (Slot (Val), V);
end Set_4_Bit_Val;
procedure Set_8_Bit_Val
(N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit)
is
- L : constant Field_Offset := 4;
+ L : constant Field_Offset := Slot_Size / 8;
pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L));
- subtype Offset_In_Slot is Field_Offset range 0 .. L - 1;
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L);
+ V : constant Integer := Integer ((Offset mod L) * (Slot_Size / L));
begin
- case Offset_In_Slot'(Offset mod L) is
- when 0 => S.Slot_8.F0 := Val;
- when 1 => S.Slot_8.F1 := Val;
- when 2 => S.Slot_8.F2 := Val;
- when 3 => S.Slot_8.F3 := Val;
- end case;
+ S := (S and not Shift_Left (255, V)) or Shift_Left (Slot (Val), V);
end Set_8_Bit_Val;
procedure Set_32_Bit_Val
S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset);
begin
- S.Slot_32 := Val;
+ S := Slot (Val);
end Set_32_Bit_Val;
end Atree_Private_Part;
----------------------
procedure Print_Atree_Info (N : Node_Or_Entity_Id) is
- function Cast is new Unchecked_Conversion (Slot_32_Bit, Int);
+ function Cast is new Unchecked_Conversion (Slot, Int);
begin
Write_Int (Int (Size_In_Slots (N)));
Write_Str (" slots (");
for Off in Off_0 (N) .. Off_L (N) loop
Write_Str (" ");
- Write_Int (Cast (Slots.Table (Off).Slot_32));
+ Write_Int (Cast (Slots.Table (Off)));
end loop;
Write_Eol;
Locked := False;
end Unlock_Nodes;
- Zero : constant Slot := (Field_Size => 32, Slot_32 => 0);
+ Zero : constant Slot := 0;
procedure Zero_Slots (F, L : Node_Offset) is
begin
Table_Increment => Alloc.Node_Offsets_Increment,
Table_Name => "Node_Offsets");
- -- We define type Slot as a packed Unchecked_Union of slots with
- -- appropriate numbers of components of appropriate size. The reason
- -- for this (as opposed to using packed arrays) is that we are using
- -- bit fields on the C++ side, and C++ doesn't have packed arrays.
-
- type Field_1_Bit is mod 2**1;
- type Slot_1_Bit is record -- 32 1-bit fields
- F0, F1, F2, F3, F4, F5, F6, F7, F8, F9,
- F10, F11, F12, F13, F14, F15, F16, F17, F18, F19,
- F20, F21, F22, F23, F24, F25, F26, F27, F28, F29,
- F30, F31 :
- Field_1_Bit;
- end record with Pack, Convention => C;
- pragma Assert (Slot_1_Bit'Size = 32);
-
- type Field_2_Bit is mod 2**2;
- type Slot_2_Bit is record -- 16 2-bit fields
- F0, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15 :
- Field_2_Bit;
- end record with Pack, Convention => C;
- pragma Assert (Slot_2_Bit'Size = 32);
-
- type Field_4_Bit is mod 2**4;
- type Slot_4_Bit is record -- 8 4-bit fields
- F0, F1, F2, F3, F4, F5, F6, F7 :
- Field_4_Bit;
- end record with Pack, Convention => C;
- pragma Assert (Slot_4_Bit'Size = 32);
-
- type Field_8_Bit is mod 2**8;
- type Slot_8_Bit is record -- 4 8-bit fields
- F0, F1, F2, F3 :
- Field_8_Bit;
- end record with Pack, Convention => C;
- pragma Assert (Slot_8_Bit'Size = 32);
-
+ -- We define the type Slot as a 32-bit modular integer. It is logically
+ -- split into the appropriate numbers of components of appropriate size,
+ -- but this splitting is not explicit because packed arrays cannot be
+ -- properly interfaced in C/C++ and packed records are way too slow.
+
+ Slot_Size : constant := 32;
+ type Slot is mod 2**Slot_Size;
+ for Slot'Size use Slot_Size;
+ pragma Provide_Shift_Operators (Slot);
+
+ type Field_1_Bit is mod 2**1;
+ type Field_2_Bit is mod 2**2;
+ type Field_4_Bit is mod 2**4;
+ type Field_8_Bit is mod 2**8;
type Field_32_Bit is mod 2**32;
- subtype Slot_32_Bit is Field_32_Bit; -- 1 32-bit field
- pragma Assert (Slot_32_Bit'Size = 32);
-
- type Slot (Field_Size : Field_Size_In_Bits := 9999) is record
- case Field_Size is
- when 1 => Slot_1 : Slot_1_Bit;
- when 2 => Slot_2 : Slot_2_Bit;
- when 4 => Slot_4 : Slot_4_Bit;
- when 8 => Slot_8 : Slot_8_Bit;
- when 32 => Slot_32 : Slot_32_Bit;
- when others => null;
- end case;
- end record with Unchecked_Union;
- pragma Assert (Slot'Size = 32);
Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1;
extern Field_Offset *Node_Offsets_Ptr;
extern any_slot *Slots_Ptr;
-INLINE Union_Id Get_1_Bit_Field (Node_Id N, Field_Offset Offset);
-INLINE Union_Id Get_2_Bit_Field (Node_Id N, Field_Offset Offset);
-INLINE Union_Id Get_4_Bit_Field (Node_Id N, Field_Offset Offset);
-INLINE Union_Id Get_8_Bit_Field (Node_Id N, Field_Offset Offset);
-INLINE Union_Id Get_32_Bit_Field (Node_Id N, Field_Offset Offset);
-INLINE Union_Id Get_32_Bit_Field_With_Default (Node_Id N, Field_Offset Offset,
- Union_Id Default_Value);
-
-INLINE Union_Id
+INLINE unsigned int Get_1_Bit_Field (Node_Id, Field_Offset);
+INLINE unsigned int Get_2_Bit_Field (Node_Id, Field_Offset);
+INLINE unsigned int Get_4_Bit_Field (Node_Id, Field_Offset);
+INLINE unsigned int Get_8_Bit_Field (Node_Id, Field_Offset);
+INLINE unsigned int Get_32_Bit_Field (Node_Id, Field_Offset);
+INLINE unsigned int Get_32_Bit_Field_With_Default (Node_Id, Field_Offset,
+ unsigned int);
+
+INLINE unsigned int
Get_1_Bit_Field (Node_Id N, Field_Offset Offset)
{
- const Field_Offset L = 32;
-
- slot_1_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_1;
-
- switch (Offset % L)
- {
- case 0: return slot.f0;
- case 1: return slot.f1;
- case 2: return slot.f2;
- case 3: return slot.f3;
- case 4: return slot.f4;
- case 5: return slot.f5;
- case 6: return slot.f6;
- case 7: return slot.f7;
- case 8: return slot.f8;
- case 9: return slot.f9;
- case 10: return slot.f10;
- case 11: return slot.f11;
- case 12: return slot.f12;
- case 13: return slot.f13;
- case 14: return slot.f14;
- case 15: return slot.f15;
- case 16: return slot.f16;
- case 17: return slot.f17;
- case 18: return slot.f18;
- case 19: return slot.f19;
- case 20: return slot.f20;
- case 21: return slot.f21;
- case 22: return slot.f22;
- case 23: return slot.f23;
- case 24: return slot.f24;
- case 25: return slot.f25;
- case 26: return slot.f26;
- case 27: return slot.f27;
- case 28: return slot.f28;
- case 29: return slot.f29;
- case 30: return slot.f30;
- case 31: return slot.f31;
- default: gcc_unreachable ();
- }
+ const Field_Offset L = Slot_Size / 1;
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
+ return (slot >> (Offset % L) * (Slot_Size / L)) & 1;
}
-INLINE Union_Id
+INLINE unsigned int
Get_2_Bit_Field (Node_Id N, Field_Offset Offset)
{
- const Field_Offset L = 16;
-
- slot_2_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_2;
-
- switch (Offset % L)
- {
- case 0: return slot.f0;
- case 1: return slot.f1;
- case 2: return slot.f2;
- case 3: return slot.f3;
- case 4: return slot.f4;
- case 5: return slot.f5;
- case 6: return slot.f6;
- case 7: return slot.f7;
- case 8: return slot.f8;
- case 9: return slot.f9;
- case 10: return slot.f10;
- case 11: return slot.f11;
- case 12: return slot.f12;
- case 13: return slot.f13;
- case 14: return slot.f14;
- case 15: return slot.f15;
- default: gcc_unreachable ();
- }
+ const Field_Offset L = Slot_Size / 2;
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
+ return (slot >> (Offset % L) * (Slot_Size / L)) & 3;
}
-INLINE Union_Id
+INLINE unsigned int
Get_4_Bit_Field (Node_Id N, Field_Offset Offset)
{
- const Field_Offset L = 8;
-
- slot_4_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_4;
-
- switch (Offset % L)
- {
- case 0: return slot.f0;
- case 1: return slot.f1;
- case 2: return slot.f2;
- case 3: return slot.f3;
- case 4: return slot.f4;
- case 5: return slot.f5;
- case 6: return slot.f6;
- case 7: return slot.f7;
- default: gcc_unreachable ();
- }
+ const Field_Offset L = Slot_Size / 4;
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
+ return (slot >> (Offset % L) * (Slot_Size / L)) & 15;
}
-INLINE Union_Id
+INLINE unsigned int
Get_8_Bit_Field (Node_Id N, Field_Offset Offset)
{
- const Field_Offset L = 4;
-
- slot_8_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_8;
-
- switch (Offset % L)
- {
- case 0: return slot.f0;
- case 1: return slot.f1;
- case 2: return slot.f2;
- case 3: return slot.f3;
- default: gcc_unreachable ();
- }
+ const Field_Offset L = Slot_Size / 8;
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
+ return (slot >> (Offset % L) * (Slot_Size / L)) & 255;
}
-INLINE Union_Id
+INLINE unsigned int
Get_32_Bit_Field (Node_Id N, Field_Offset Offset)
{
const Field_Offset L = 1;
-
- slot_32_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_32;
-
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
return slot;
}
-INLINE Union_Id
+INLINE unsigned int
Get_32_Bit_Field_With_Default (Node_Id N, Field_Offset Offset,
- Union_Id Default_Value)
+ unsigned int Default_Value)
{
const Field_Offset L = 1;
-
- slot_32_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset / L))->slot_32;
-
+ any_slot slot = *(Slots_Ptr + Node_Offsets_Ptr[N] + Offset / L);
return slot == Empty ? Default_Value : slot;
}
projects / thirdparty / gcc.git / commitdiff
