summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-19 10:55:09 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-19 10:55:09 +0000
commit23e833138efd20119ccf186f5fed1c8ac4578282 (patch)
tree705d0c03d0e8dd8480aa77c15e216d9ffa4f0325 /gcc/ada
parent13b802d70d691cdc8dd1157523d517f822313e88 (diff)
downloadgcc-23e833138efd20119ccf186f5fed1c8ac4578282.tar.gz
* a-stmaco.ads, exp_util.ads, exp_util.adb, i-cpp.ads, i-cpp.adb:
Minor reformatting througout (including new function specs) Add ??? comments asking for clarification. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@90901 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/a-stmaco.ads6
-rw-r--r--gcc/ada/exp_util.adb105
-rw-r--r--gcc/ada/exp_util.ads15
-rw-r--r--gcc/ada/i-cpp.adb22
-rw-r--r--gcc/ada/i-cpp.ads24
5 files changed, 74 insertions, 98 deletions
diff --git a/gcc/ada/a-stmaco.ads b/gcc/ada/a-stmaco.ads
index 08e36a9fb2e..07c8ce14f2c 100644
--- a/gcc/ada/a-stmaco.ads
+++ b/gcc/ada/a-stmaco.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -70,7 +70,7 @@ private
others => False);
Graphic_Set : constant Character_Set :=
- (L.Space .. L.Tilde => True,
+ (L.Space .. L.Tilde => True,
L.No_Break_Space .. L.LC_Y_Diaeresis => True,
others => False);
@@ -107,7 +107,7 @@ private
others => False);
Decimal_Digit_Set : constant Character_Set :=
- ('0' .. '9' => True,
+ ('0' .. '9' => True,
others => False);
Hexadecimal_Digit_Set : constant Character_Set :=
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5d5103785ea..25522c4b509 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -68,8 +68,7 @@ package body Exp_Util is
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id;
- Dyn : Boolean := False)
- return Node_Id;
+ Dyn : Boolean := False) return Node_Id;
-- Build function to generate the image string for a task that is an
-- array component, concatenating the images of each index. To avoid
-- storage leaks, the string is built with successive slice assignments.
@@ -81,8 +80,7 @@ package body Exp_Util is
(Loc : Source_Ptr;
Decls : List_Id;
Stats : List_Id;
- Res : Entity_Id)
- return Node_Id;
+ Res : Entity_Id) return Node_Id;
-- Common processing for Task_Array_Image and Task_Record_Image.
-- Build function body that computes image.
@@ -101,8 +99,7 @@ package body Exp_Util is
function Build_Task_Record_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
- Dyn : Boolean := False)
- return Node_Id;
+ Dyn : Boolean := False) return Node_Id;
-- Build function to generate the image string for a task that is a
-- record component. Concatenate name of variable with that of selector.
-- The flag Dyn indicates whether this is called for the initialization
@@ -110,9 +107,8 @@ package body Exp_Util is
-- created task that is assigned to a selected component.
function Make_CW_Equivalent_Type
- (T : Entity_Id;
- E : Node_Id)
- return Entity_Id;
+ (T : Entity_Id;
+ E : Node_Id) return Entity_Id;
-- T is a class-wide type entity, E is the initial expression node that
-- constrains T in case such as: " X: T := E" or "new T'(E)"
-- This function returns the entity of the Equivalent type and inserts
@@ -128,8 +124,7 @@ package body Exp_Util is
function Make_Literal_Range
(Loc : Source_Ptr;
- Literal_Typ : Entity_Id)
- return Node_Id;
+ Literal_Typ : Entity_Id) return Node_Id;
-- Produce a Range node whose bounds are:
-- Low_Bound (Literal_Type) ..
-- Low_Bound (Literal_Type) + Length (Literal_Typ) - 1
@@ -137,9 +132,8 @@ package body Exp_Util is
function New_Class_Wide_Subtype
(CW_Typ : Entity_Id;
- N : Node_Id)
- return Entity_Id;
- -- Create an implicit subtype of CW_Typ attached to node N.
+ N : Node_Id) return Entity_Id;
+ -- Create an implicit subtype of CW_Typ attached to node N
----------------------
-- Adjust_Condition --
@@ -376,14 +370,13 @@ package body Exp_Util is
(Loc : Source_Ptr;
Id_Ref : Node_Id;
A_Type : Entity_Id;
- Dyn : Boolean := False)
- return Node_Id
+ Dyn : Boolean := False) return Node_Id
is
Dims : constant Nat := Number_Dimensions (A_Type);
- -- Number of dimensions for array of tasks.
+ -- Number of dimensions for array of tasks
Temps : array (1 .. Dims) of Entity_Id;
- -- Array of temporaries to hold string for each index.
+ -- Array of temporaries to hold string for each index
Indx : Node_Id;
-- Index expression
@@ -425,7 +418,8 @@ package body Exp_Util is
Defining_Identifier => Pref,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
- Make_String_Literal (Loc, Strval => String_From_Name_Buffer)));
+ Make_String_Literal (Loc,
+ Strval => String_From_Name_Buffer)));
else
Append_To (Decls,
@@ -588,8 +582,7 @@ package body Exp_Util is
function Build_Task_Image_Decls
(Loc : Source_Ptr;
Id_Ref : Node_Id;
- A_Type : Entity_Id)
- return List_Id
+ A_Type : Entity_Id) return List_Id
is
Decls : constant List_Id := New_List;
T_Id : Entity_Id := Empty;
@@ -617,8 +610,8 @@ package body Exp_Util is
Defining_Identifier => T_Id,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
- Make_String_Literal
- (Loc, Strval => String_From_Name_Buffer)));
+ Make_String_Literal (Loc,
+ Strval => String_From_Name_Buffer)));
else
if Nkind (Id_Ref) = N_Identifier
@@ -635,8 +628,9 @@ package body Exp_Util is
Get_Name_String (Chars (Id_Ref));
- Expr := Make_String_Literal
- (Loc, Strval => String_From_Name_Buffer);
+ Expr :=
+ Make_String_Literal (Loc,
+ Strval => String_From_Name_Buffer);
elsif Nkind (Id_Ref) = N_Selected_Component then
T_Id :=
@@ -677,8 +671,7 @@ package body Exp_Util is
(Loc : Source_Ptr;
Decls : List_Id;
Stats : List_Id;
- Res : Entity_Id)
- return Node_Id
+ Res : Entity_Id) return Node_Id
is
Spec : Node_Id;
@@ -791,8 +784,7 @@ package body Exp_Util is
function Build_Task_Record_Image
(Loc : Source_Ptr;
Id_Ref : Node_Id;
- Dyn : Boolean := False)
- return Node_Id
+ Dyn : Boolean := False) return Node_Id
is
Len : Entity_Id;
-- Total length of generated name
@@ -807,7 +799,7 @@ package body Exp_Util is
-- Name of enclosing variable, prefix of resulting name
Sum : Node_Id;
- -- Expression to compute total size of string.
+ -- Expression to compute total size of string
Sel : Entity_Id;
-- Entity for selector name
@@ -828,7 +820,8 @@ package body Exp_Util is
Defining_Identifier => Pref,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
- Make_String_Literal (Loc, Strval => String_From_Name_Buffer)));
+ Make_String_Literal (Loc,
+ Strval => String_From_Name_Buffer)));
else
Append_To (Decls,
@@ -847,7 +840,8 @@ package body Exp_Util is
Defining_Identifier => Sel,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression =>
- Make_String_Literal (Loc, Strval => String_From_Name_Buffer)));
+ Make_String_Literal (Loc,
+ Strval => String_From_Name_Buffer)));
Sum := Make_Integer_Literal (Loc, Nat (Name_Len + 1));
@@ -1010,8 +1004,7 @@ package body Exp_Util is
function Duplicate_Subexpr
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id
+ Name_Req : Boolean := False) return Node_Id
is
begin
Remove_Side_Effects (Exp, Name_Req);
@@ -1024,8 +1017,7 @@ package body Exp_Util is
function Duplicate_Subexpr_No_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id
+ Name_Req : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
@@ -1042,8 +1034,7 @@ package body Exp_Util is
function Duplicate_Subexpr_Move_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id
+ Name_Req : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
@@ -1075,7 +1066,6 @@ package body Exp_Util is
-- in gigi.
P := Parent (N);
-
while Present (P)
and then Nkind (P) /= N_Subprogram_Body
loop
@@ -1228,7 +1218,7 @@ package body Exp_Util is
then
if Is_Itype (Exp_Typ) then
- -- No need to generate a new one.
+ -- No need to generate a new one
T := Exp_Typ;
@@ -1523,10 +1513,9 @@ package body Exp_Util is
-- condition, Sens is True if the condition is true and
-- False if it needs inverting.
- Cond := Condition (CV);
-
-- Deal with NOT operators, inverting sense
+ Cond := Condition (CV);
while Nkind (Cond) = N_Op_Not loop
Cond := Right_Opnd (Cond);
Sens := not Sens;
@@ -1819,7 +1808,7 @@ package body Exp_Util is
return;
end if;
- -- Statements, declarations, pragmas, representation clauses.
+ -- Statements, declarations, pragmas, representation clauses
when
-- Statements
@@ -1981,13 +1970,14 @@ package body Exp_Util is
else
declare
- Decl : Node_Id := Assoc_Node;
+ Decl : Node_Id;
begin
-- Check whether these actions were generated
-- by a declaration that is part of the loop_
-- actions for the component_association.
+ Decl := Assoc_Node;
while Present (Decl) loop
exit when Parent (Decl) = P
and then Is_List_Member (Decl)
@@ -2552,7 +2542,6 @@ package body Exp_Util is
if Result and then Nkind (P) = N_Indexed_Component then
Expr := First (Expressions (P));
-
while Present (Expr) loop
Force_Evaluation (Expr);
Next (Expr);
@@ -2669,9 +2658,9 @@ package body Exp_Util is
elsif Nkind (N) = N_Case_Statement then
declare
- Alt : Node_Id := First (Alternatives (N));
-
+ Alt : Node_Id;
begin
+ Alt := First (Alternatives (N));
while Present (Alt) loop
Kill_Dead_Code (Statements (Alt));
Next (Alt);
@@ -2816,9 +2805,8 @@ package body Exp_Util is
-- derived types
function Make_CW_Equivalent_Type
- (T : Entity_Id;
- E : Node_Id)
- return Entity_Id
+ (T : Entity_Id;
+ E : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (E);
Root_Typ : constant Entity_Id := Root_Type (T);
@@ -2955,8 +2943,7 @@ package body Exp_Util is
function Make_Literal_Range
(Loc : Source_Ptr;
- Literal_Typ : Entity_Id)
- return Node_Id
+ Literal_Typ : Entity_Id) return Node_Id
is
Lo : constant Node_Id :=
New_Copy_Tree (String_Literal_Low_Bound (Literal_Typ));
@@ -2993,8 +2980,7 @@ package body Exp_Util is
function Make_Subtype_From_Expr
(E : Node_Id;
- Unc_Typ : Entity_Id)
- return Node_Id
+ Unc_Typ : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (E);
List_Constr : constant List_Id := New_List;
@@ -3152,8 +3138,7 @@ package body Exp_Util is
function New_Class_Wide_Subtype
(CW_Typ : Entity_Id;
- N : Node_Id)
- return Entity_Id
+ N : Node_Id) return Entity_Id
is
Res : constant Entity_Id := Create_Itype (E_Void, N);
Res_Name : constant Name_Id := Chars (Res);
@@ -3479,7 +3464,6 @@ package body Exp_Util is
else
N := First (L);
-
while Present (N) loop
if not Side_Effect_Free (N) then
return False;
@@ -3636,7 +3620,7 @@ package body Exp_Util is
Set_Is_Renaming_Of_Object (Def_Id, False);
end if;
- -- If it is a scalar type, just make a copy.
+ -- If it is a scalar type, just make a copy
elsif Is_Elementary_Type (Exp_Type) then
Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
@@ -3927,7 +3911,7 @@ package body Exp_Util is
then
return True;
- -- Otherwise, Gigi cannot handle this and we must make a temporary.
+ -- Otherwise, Gigi cannot handle this and we must make a temporary
else
return False;
@@ -3997,8 +3981,7 @@ package body Exp_Util is
function Target_Has_Fixed_Ops
(Left_Typ : Entity_Id;
Right_Typ : Entity_Id;
- Result_Typ : Entity_Id)
- return Boolean
+ Result_Typ : Entity_Id) return Boolean
is
function Is_Fractional_Type (Typ : Entity_Id) return Boolean;
-- Return True if the given type is a fixed-point type with a small
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 02c6011113d..3e68682b437 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -257,8 +257,7 @@ package Exp_Util is
function Duplicate_Subexpr
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id;
+ Name_Req : Boolean := False) return Node_Id;
-- Given the node for a subexpression, this function makes a logical
-- copy of the subexpression, and returns it. This is intended for use
-- when the expansion of an expression needs to repeat part of it. For
@@ -280,8 +279,7 @@ package Exp_Util is
function Duplicate_Subexpr_No_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id;
+ Name_Req : Boolean := False) return Node_Id;
-- Identical in effect to Duplicate_Subexpr, except that Remove_Checks
-- is called on the result, so that the duplicated expression does not
-- include checks. This is appropriate for use when Exp, the original
@@ -290,8 +288,7 @@ package Exp_Util is
function Duplicate_Subexpr_Move_Checks
(Exp : Node_Id;
- Name_Req : Boolean := False)
- return Node_Id;
+ Name_Req : Boolean := False) return Node_Id;
-- Identical in effect to Duplicate_Subexpr, except that Remove_Checks
-- is called on Exp after the duplication is complete, so that the
-- original expression does not include checks. In this case the result
@@ -482,8 +479,7 @@ package Exp_Util is
function Make_Subtype_From_Expr
(E : Node_Id;
- Unc_Typ : Entity_Id)
- return Node_Id;
+ Unc_Typ : Entity_Id) return Node_Id;
-- Returns a subtype indication corresponding to the actual type of an
-- expression E. Unc_Typ is an unconstrained array or record, or
-- a classwide type.
@@ -536,8 +532,7 @@ package Exp_Util is
function Target_Has_Fixed_Ops
(Left_Typ : Entity_Id;
Right_Typ : Entity_Id;
- Result_Typ : Entity_Id)
- return Boolean;
+ Result_Typ : Entity_Id) return Boolean;
-- Returns True if and only if the target machine has direct support
-- for fixed-by-fixed multiplications and divisions for the given
-- operand and result types. This is called in package Exp_Fixd to
diff --git a/gcc/ada/i-cpp.adb b/gcc/ada/i-cpp.adb
index 387dcb5583c..24015f10d0b 100644
--- a/gcc/ada/i-cpp.adb
+++ b/gcc/ada/i-cpp.adb
@@ -38,6 +38,8 @@ with Unchecked_Conversion;
package body Interfaces.CPP is
+ -- The declarations below need (extensive) comments ???
+
subtype Cstring is String (Positive);
type Cstring_Ptr is access all Cstring;
type Tag_Table is array (Natural range <>) of Vtable_Ptr;
@@ -52,7 +54,7 @@ package body Interfaces.CPP is
end record;
type Vtable_Entry is record
- Pfn : System.Address;
+ Pfn : System.Address;
end record;
type Type_Specific_Data_Ptr is access all Type_Specific_Data;
@@ -97,8 +99,7 @@ package body Interfaces.CPP is
function CPP_CW_Membership
(Obj_Tag : Vtable_Ptr;
- Typ_Tag : Vtable_Ptr)
- return Boolean
+ Typ_Tag : Vtable_Ptr) return Boolean
is
Pos : constant Integer := Obj_Tag.TSD.Idepth - Typ_Tag.TSD.Idepth;
begin
@@ -138,8 +139,8 @@ package body Interfaces.CPP is
function CPP_Get_Prim_Op_Address
(T : Vtable_Ptr;
- Position : Positive)
- return Address is
+ Position : Positive) return Address
+ is
begin
return T.Prims_Ptr (Position).Pfn;
end CPP_Get_Prim_Op_Address;
@@ -150,7 +151,6 @@ package body Interfaces.CPP is
function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset is
pragma Warnings (Off, T);
-
begin
return 0;
end CPP_Get_RC_Offset;
@@ -161,7 +161,6 @@ package body Interfaces.CPP is
function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean is
pragma Warnings (Off, T);
-
begin
return True;
end CPP_Get_Remotely_Callable;
@@ -199,8 +198,8 @@ package body Interfaces.CPP is
(Old_TSD : Address;
New_Tag : Vtable_Ptr)
is
- TSD : constant Type_Specific_Data_Ptr
- := To_Type_Specific_Data_Ptr (Old_TSD);
+ TSD : constant Type_Specific_Data_Ptr :=
+ To_Type_Specific_Data_Ptr (Old_TSD);
New_TSD : Type_Specific_Data renames New_Tag.TSD.all;
@@ -266,7 +265,6 @@ package body Interfaces.CPP is
procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset) is
pragma Warnings (Off, T);
pragma Warnings (Off, Value);
-
begin
null;
end CPP_Set_RC_Offset;
@@ -278,7 +276,6 @@ package body Interfaces.CPP is
procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean) is
pragma Warnings (Off, T);
pragma Warnings (Off, Value);
-
begin
null;
end CPP_Set_Remotely_Callable;
@@ -318,7 +315,6 @@ package body Interfaces.CPP is
function Expanded_Name (T : Vtable_Ptr) return String is
Result : constant Cstring_Ptr := T.TSD.Expanded_Name;
-
begin
return Result (1 .. Length (Result));
end Expanded_Name;
@@ -329,7 +325,6 @@ package body Interfaces.CPP is
function External_Tag (T : Vtable_Ptr) return String is
Result : constant Cstring_Ptr := T.TSD.External_Tag;
-
begin
return Result (1 .. Length (Result));
end External_Tag;
@@ -348,4 +343,5 @@ package body Interfaces.CPP is
return Len - 1;
end Length;
+
end Interfaces.CPP;
diff --git a/gcc/ada/i-cpp.ads b/gcc/ada/i-cpp.ads
index 9a5998837a2..a53c38b2242 100644
--- a/gcc/ada/i-cpp.ads
+++ b/gcc/ada/i-cpp.ads
@@ -33,6 +33,16 @@
-- Definitions for interfacing to C++ classes
+-- This package corresponds to Ada.Tags but applied to tagged types which are
+-- are imported from C++ and correspond exactly to a C++ Class. The code that
+-- the GNAT front end generates does not know about the structure of the C++
+-- dispatch table (Vtable) but always accesses it through the procedural
+-- interface defined in this package, thus the implementation of this package
+-- (the body) can be customized to another C++ compiler without any change in
+-- the compiler code itself as long as this procedural interface is respected.
+-- Note that Ada.Tags defines a very similar procedural interface to the
+-- regular Ada Dispatch Table.
+
with System;
with System.Storage_Elements;
@@ -41,23 +51,15 @@ package Interfaces.CPP is
package S renames System;
package SSE renames System.Storage_Elements;
- -- This package corresponds to Ada.Tags but applied to tagged
- -- types which are 'imported' from C++ and correspond exactly to a
- -- C++ Class. GNAT doesn't know about the structure of the C++
- -- dispatch table (Vtable) but always accesses it through the
- -- procedural interface defined below, thus the implementation of
- -- this package (the body) can be customized to another C++
- -- compiler without any change in the compiler code itself as long
- -- as this procedural interface is respected. Note that Ada.Tags
- -- defines a very similar procedural interface to the regular Ada
- -- Dispatch Table.
-
type Vtable_Ptr is private;
function Expanded_Name (T : Vtable_Ptr) return String;
function External_Tag (T : Vtable_Ptr) return String;
private
+ -- These subprograms are in the private part. They are never accessed
+ -- directly except from compiler generated code, which has access to
+ -- private components of packages via the Rtsfind interface.
procedure CPP_Set_Prim_Op_Address
(T : Vtable_Ptr;