From bebbff91ba61e63901378aaee1ba011dd0a1587b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 19 Nov 2004 11:55:09 +0100 Subject: [PATCH] a-stmaco.ads, [...]: Minor reformatting througout (including new function specs) Add ??? comments... * 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. From-SVN: r90901 --- gcc/ada/a-stmaco.ads | 6 +-- gcc/ada/exp_util.adb | 105 +++++++++++++++++++++------------------------------ gcc/ada/exp_util.ads | 15 +++----- gcc/ada/i-cpp.adb | 22 +++++------ gcc/ada/i-cpp.ads | 24 ++++++------ 5 files changed, 74 insertions(+), 98 deletions(-) diff --git a/gcc/ada/a-stmaco.ads b/gcc/ada/a-stmaco.ads index 08e36a9..07c8ce1 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 5d51037..25522c4 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 02c6011..3e68682 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 387dcb5..24015f1 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 9a59988..a53c38b 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; -- 2.7.4