diff options
Diffstat (limited to 'gcc/ada/a-tags.adb')
| -rw-r--r-- | gcc/ada/a-tags.adb | 58 |
1 files changed, 24 insertions, 34 deletions
diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb index f88874d79fa..a2e40f8d4ef 100644 --- a/gcc/ada/a-tags.adb +++ b/gcc/ada/a-tags.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -87,25 +87,15 @@ package body Ada.Tags is Prims_Ptr : Address_Array (Positive); end record; - ------------------------------------------- - -- Unchecked Conversions for Tag and TSD -- - ------------------------------------------- - - function To_Type_Specific_Data_Ptr is - new Unchecked_Conversion (S.Address, Type_Specific_Data_Ptr); - - function To_Address is - new Unchecked_Conversion (Type_Specific_Data_Ptr, S.Address); - --------------------------------------------- -- Unchecked Conversions for String Fields -- --------------------------------------------- function To_Cstring_Ptr is - new Unchecked_Conversion (S.Address, Cstring_Ptr); + new Unchecked_Conversion (System.Address, Cstring_Ptr); function To_Address is - new Unchecked_Conversion (Cstring_Ptr, S.Address); + new Unchecked_Conversion (Cstring_Ptr, System.Address); ----------------------- -- Local Subprograms -- @@ -128,8 +118,8 @@ package body Ada.Tags is package HTable_Subprograms is procedure Set_HT_Link (T : Tag; Next : Tag); function Get_HT_Link (T : Tag) return Tag; - function Hash (F : S.Address) return HTable_Headers; - function Equal (A, B : S.Address) return Boolean; + function Hash (F : System.Address) return HTable_Headers; + function Equal (A, B : System.Address) return Boolean; end HTable_Subprograms; package External_Tag_HTable is new System.HTable.Static_HTable ( @@ -139,7 +129,7 @@ package body Ada.Tags is Null_Ptr => null, Set_Next => HTable_Subprograms.Set_HT_Link, Next => HTable_Subprograms.Get_HT_Link, - Key => S.Address, + Key => System.Address, Get_Key => Get_External_Tag, Hash => HTable_Subprograms.Hash, Equal => HTable_Subprograms.Equal); @@ -156,7 +146,7 @@ package body Ada.Tags is -- Equal -- ----------- - function Equal (A, B : S.Address) return Boolean is + function Equal (A, B : System.Address) return Boolean is Str1 : constant Cstring_Ptr := To_Cstring_Ptr (A); Str2 : constant Cstring_Ptr := To_Cstring_Ptr (B); J : Integer := 1; @@ -188,7 +178,7 @@ package body Ada.Tags is -- Hash -- ---------- - function Hash (F : S.Address) return HTable_Headers is + function Hash (F : System.Address) return HTable_Headers is function H is new System.HTable.Hash (HTable_Headers); Str : constant Cstring_Ptr := To_Cstring_Ptr (F); Res : constant HTable_Headers := H (Str (1 .. Length (Str))); @@ -260,7 +250,7 @@ package body Ada.Tags is -- Get_Expanded_Name -- ----------------------- - function Get_Expanded_Name (T : Tag) return S.Address is + function Get_Expanded_Name (T : Tag) return System.Address is begin return To_Address (T.TSD.Expanded_Name); end Get_Expanded_Name; @@ -269,7 +259,7 @@ package body Ada.Tags is -- Get_External_Tag -- ---------------------- - function Get_External_Tag (T : Tag) return S.Address is + function Get_External_Tag (T : Tag) return System.Address is begin return To_Address (T.TSD.External_Tag); end Get_External_Tag; @@ -289,8 +279,7 @@ package body Ada.Tags is function Get_Prim_Op_Address (T : Tag; - Position : Positive) - return S.Address + Position : Positive) return System.Address is begin return T.Prims_Ptr (Position); @@ -318,7 +307,7 @@ package body Ada.Tags is -- Get_TSD -- ------------- - function Get_TSD (T : Tag) return S.Address is + function Get_TSD (T : Tag) return System.Address is begin return To_Address (T.TSD); end Get_TSD; @@ -343,7 +332,7 @@ package body Ada.Tags is -- Inherit_TSD -- ----------------- - procedure Inherit_TSD (Old_TSD : S.Address; New_Tag : Tag) is + procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag) is TSD : constant Type_Specific_Data_Ptr := To_Type_Specific_Data_Ptr (Old_TSD); New_TSD : Type_Specific_Data renames New_Tag.TSD.all; @@ -411,15 +400,16 @@ package body Ada.Tags is -- Parent_Size -- ----------------- - type Acc_Size is access function (A : S.Address) return Long_Long_Integer; - function To_Acc_Size is new Unchecked_Conversion (S.Address, Acc_Size); + type Acc_Size + is access function (A : System.Address) return Long_Long_Integer; + + function To_Acc_Size is new Unchecked_Conversion (System.Address, Acc_Size); -- The profile of the implicitly defined _size primitive function Parent_Size - (Obj : S.Address; - T : Tag) - return SSE.Storage_Count is - + (Obj : System.Address; + T : Tag) return SSE.Storage_Count + is Parent_Tag : constant Tag := T.TSD.Ancestor_Tags (1); -- The tag of the parent type through the dispatch table @@ -455,7 +445,7 @@ package body Ada.Tags is -- Set_Expanded_Name -- ----------------------- - procedure Set_Expanded_Name (T : Tag; Value : S.Address) is + procedure Set_Expanded_Name (T : Tag; Value : System.Address) is begin T.TSD.Expanded_Name := To_Cstring_Ptr (Value); end Set_Expanded_Name; @@ -464,7 +454,7 @@ package body Ada.Tags is -- Set_External_Tag -- ---------------------- - procedure Set_External_Tag (T : Tag; Value : S.Address) is + procedure Set_External_Tag (T : Tag; Value : System.Address) is begin T.TSD.External_Tag := To_Cstring_Ptr (Value); end Set_External_Tag; @@ -488,7 +478,7 @@ package body Ada.Tags is procedure Set_Prim_Op_Address (T : Tag; Position : Positive; - Value : S.Address) + Value : System.Address) is begin T.Prims_Ptr (Position) := Value; @@ -520,7 +510,7 @@ package body Ada.Tags is -- Set_TSD -- ------------- - procedure Set_TSD (T : Tag; Value : S.Address) is + procedure Set_TSD (T : Tag; Value : System.Address) is begin T.TSD := To_Type_Specific_Data_Ptr (Value); end Set_TSD; |