This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [RFC] Add aarch64 support for ada


> But it breaks on IA-64 for the same reason as on Aarch64 so we'll need to
> find something else.

Tentative revised patch attached.  Can you give it a try when you have some 
time?  There is a rationale based on my understanding in types.h.  TIA.

-- 
Eric Botcazou
Index: comperr.adb
===================================================================
--- comperr.adb	(revision 209671)
+++ comperr.adb	(working copy)
@@ -74,8 +74,8 @@ package body Comperr is
 
    procedure Compiler_Abort
      (X            : String;
-      Code         : Integer := 0;
-      Fallback_Loc : String := "")
+      Fallback_Loc : String := "";
+      Code         : Integer := 0)
    is
       --  The procedures below output a "bug box" with information about
       --  the cause of the compiler abort and about the preferred method
Index: comperr.ads
===================================================================
--- comperr.ads	(revision 209671)
+++ comperr.ads	(working copy)
@@ -31,8 +31,8 @@ package Comperr is
 
    procedure Compiler_Abort
      (X            : String;
-      Code         : Integer := 0;
-      Fallback_Loc : String := "");
+      Fallback_Loc : String := "";
+      Code         : Integer := 0);
    pragma No_Return (Compiler_Abort);
    --  Signals an internal compiler error. Never returns control. Depending on
    --  processing may end up raising Unrecoverable_Error, or exiting directly.
Index: fe.h
===================================================================
--- fe.h	(revision 209684)
+++ fe.h	(working copy)
@@ -39,7 +39,7 @@ extern "C" {
 /* comperr:  */
 
 #define Compiler_Abort comperr__compiler_abort
-extern int Compiler_Abort (Fat_Pointer, int, Fat_Pointer) ATTRIBUTE_NORETURN;
+extern int Compiler_Abort (String_Pointer, String_Pointer, int) ATTRIBUTE_NORETURN;
 
 /* csets: */
 
@@ -90,8 +90,8 @@ extern Node_Id Get_Attribute_Definition_
 #define Error_Msg_NE              errout__error_msg_ne
 #define Set_Identifier_Casing     errout__set_identifier_casing
 
-extern void Error_Msg_N	          (Fat_Pointer, Node_Id);
-extern void Error_Msg_NE          (Fat_Pointer, Node_Id, Entity_Id);
+extern void Error_Msg_N	          (String_Pointer, Node_Id);
+extern void Error_Msg_NE          (String_Pointer, Node_Id, Entity_Id);
 extern void Set_Identifier_Casing (Char *, const Char *);
 
 /* err_vars: */
@@ -147,11 +147,9 @@ extern void Setup_Asm_Outputs		(Node_Id)
 
 #define Get_Encoded_Name exp_dbug__get_encoded_name
 #define Get_External_Name exp_dbug__get_external_name
-#define Get_External_Name_With_Suffix exp_dbug__get_external_name_with_suffix
 
-extern void Get_Encoded_Name			(Entity_Id);
-extern void Get_External_Name			(Entity_Id, Boolean);
-extern void Get_External_Name_With_Suffix	(Entity_Id, Fat_Pointer);
+extern void Get_Encoded_Name		(Entity_Id);
+extern void Get_External_Name		(Entity_Id, Boolean, String_Pointer);
 
 /* exp_util: */
 
Index: types.h
===================================================================
--- types.h	(revision 209684)
+++ types.h	(working copy)
@@ -76,11 +76,19 @@ typedef Char *Str;
 /* Pointer to string of Chars */
 typedef Char *Str_Ptr;
 
-/* Types for the fat pointer used for strings and the template it
-   points to.  */
-typedef struct {int Low_Bound, High_Bound; } String_Template;
-typedef struct {const char *Array; String_Template *Bounds; }
-	__attribute ((aligned (sizeof (char *) * 2))) Fat_Pointer;
+/* Types for the fat pointer used for strings and the template it points to.
+   The fat pointer is conceptually a couple of pointers, but it is wrapped
+   up in a special record type.  On the Ada side, the record is naturally
+   aligned (i.e. given pointer alignment) on regular platforms, but it is
+   given twice this alignment on strict-alignment platforms for performance
+   reasons.  On the C side, for the sake of portability and simplicity, we
+   overalign it on all platforms (so the machine mode is always the same as
+   on the Ada side) but arrange to pass it in an even scalar position as a
+   parameter to functions (so the scalar parameter alignment is always the
+   same as on the Ada side).  */
+typedef struct { int Low_Bound, High_Bound; } String_Template;
+typedef struct { const char *Array; String_Template *Bounds; }
+	__attribute ((aligned (sizeof (char *) * 2))) String_Pointer;
 
 /* Types for Node/Entity Kinds:  */
 
Index: exp_dbug.adb
===================================================================
--- exp_dbug.adb	(revision 209671)
+++ exp_dbug.adb	(working copy)
@@ -507,8 +507,8 @@ package body Exp_Dbug is
    begin
       --  If not generating code, there is no need to create encoded names, and
       --  problems when the back-end is called to annotate types without full
-      --  code generation. See comments in Get_External_Name_With_Suffix for
-      --  additional details.
+      --  code generation. See comments in Get_External_Name for additional
+      --  details.
 
       --  However we do create encoded names if the back end is active, even
       --  if Operating_Mode got reset. Otherwise any serious error reported
@@ -556,7 +556,7 @@ package body Exp_Dbug is
       --  Fixed-point case
 
       if Is_Fixed_Point_Type (E) then
-         Get_External_Name_With_Suffix (E, "XF_");
+         Get_External_Name (E, True, "XF_");
          Add_Real_To_Buffer (Delta_Value (E));
 
          if Small_Value (E) /= Delta_Value (E) then
@@ -568,14 +568,14 @@ package body Exp_Dbug is
 
       elsif Vax_Float (E) then
          if Digits_Value (Base_Type (E)) = 6 then
-            Get_External_Name_With_Suffix (E, "XFF");
+            Get_External_Name (E, True, "XFF");
 
          elsif Digits_Value (Base_Type (E)) = 9 then
-            Get_External_Name_With_Suffix (E, "XFF");
+            Get_External_Name (E, True, "XFF");
 
          else
             pragma Assert (Digits_Value (Base_Type (E)) = 15);
-            Get_External_Name_With_Suffix (E, "XFG");
+            Get_External_Name (E, True, "XFG");
          end if;
 
       --  Discrete case where bounds do not match size
@@ -607,9 +607,9 @@ package body Exp_Dbug is
 
          begin
             if Biased then
-               Get_External_Name_With_Suffix (E, "XB");
+               Get_External_Name (E, True, "XB");
             else
-               Get_External_Name_With_Suffix (E, "XD");
+               Get_External_Name (E, True, "XD");
             end if;
 
             if Lo_Encode or Hi_Encode then
@@ -649,7 +649,7 @@ package body Exp_Dbug is
 
       else
          Has_Suffix := False;
-         Get_External_Name (E, Has_Suffix);
+         Get_External_Name (E);
       end if;
 
       if Debug_Flag_B and then Has_Suffix then
@@ -667,7 +667,11 @@ package body Exp_Dbug is
    -- Get_External_Name --
    -----------------------
 
-   procedure Get_External_Name (Entity : Entity_Id; Has_Suffix : Boolean) is
+   procedure Get_External_Name
+     (Entity     : Entity_Id;
+      Has_Suffix : Boolean := False;
+      Suffix     : String := "")
+   is
       E    : Entity_Id := Entity;
       Kind : Entity_Kind;
 
@@ -704,6 +708,20 @@ package body Exp_Dbug is
    --  Start of processing for Get_External_Name
 
    begin
+      --  If we are not in code generation mode, this procedure may still be
+      --  called from Back_End (more specifically - from gigi for doing type
+      --  representation annotation or some representation-specific checks).
+      --  But in this mode there is no need to mess with external names.
+
+      --  Furthermore, the call causes difficulties in this case because the
+      --  string representing the homonym number is not correctly reset as a
+      --  part of the call to Output_Homonym_Numbers_Suffix (which is not
+      --  called in gigi).
+
+      if Operating_Mode /= Generate_Code then
+         return;
+      end if;
+
       Reset_Buffers;
 
       --  If this is a child unit, we want the child
@@ -762,42 +780,13 @@ package body Exp_Dbug is
          Get_Qualified_Name_And_Append (E);
       end if;
 
-      Name_Buffer (Name_Len + 1) := ASCII.NUL;
-   end Get_External_Name;
-
-   -----------------------------------
-   -- Get_External_Name_With_Suffix --
-   -----------------------------------
-
-   procedure Get_External_Name_With_Suffix
-     (Entity : Entity_Id;
-      Suffix : String)
-   is
-      Has_Suffix : constant Boolean := (Suffix /= "");
-
-   begin
-      --  If we are not in code generation mode, this procedure may still be
-      --  called from Back_End (more specifically - from gigi for doing type
-      --  representation annotation or some representation-specific checks).
-      --  But in this mode there is no need to mess with external names.
-
-      --  Furthermore, the call causes difficulties in this case because the
-      --  string representing the homonym number is not correctly reset as a
-      --  part of the call to Output_Homonym_Numbers_Suffix (which is not
-      --  called in gigi).
-
-      if Operating_Mode /= Generate_Code then
-         return;
-      end if;
-
-      Get_External_Name (Entity, Has_Suffix);
-
       if Has_Suffix then
          Add_Str_To_Name_Buffer ("___");
          Add_Str_To_Name_Buffer (Suffix);
-         Name_Buffer (Name_Len + 1) := ASCII.NUL;
       end if;
-   end Get_External_Name_With_Suffix;
+
+      Name_Buffer (Name_Len + 1) := ASCII.NUL;
+   end Get_External_Name;
 
    --------------------------
    -- Get_Variant_Encoding --
@@ -944,7 +933,7 @@ package body Exp_Dbug is
       Suffix_Index : Int)
    is
    begin
-      Get_External_Name (Typ, Has_Suffix => False);
+      Get_External_Name (Typ);
 
       if Ancestor_Typ /= Typ then
          declare
@@ -952,7 +941,7 @@ package body Exp_Dbug is
             Save_Str : constant String (1 .. Name_Len)
                          := Name_Buffer (1 .. Name_Len);
          begin
-            Get_External_Name (Ancestor_Typ, Has_Suffix => False);
+            Get_External_Name (Ancestor_Typ);
 
             --  Append the extended name of the ancestor to the
             --  extended name of Typ
Index: exp_dbug.ads
===================================================================
--- exp_dbug.ads	(revision 209671)
+++ exp_dbug.ads	(working copy)
@@ -413,10 +413,11 @@ package Exp_Dbug is
 
    procedure Get_External_Name
      (Entity     : Entity_Id;
-      Has_Suffix : Boolean);
-   --  Set Name_Buffer and Name_Len to the external name of entity E. The
+      Has_Suffix : Boolean := False;
+      Suffix     : String := "");
+   --  Set Name_Buffer and Name_Len to the external name of Entity. The
    --  external name is the Interface_Name, if specified, unless the entity
-   --  has an address clause or a suffix.
+   --  has an address clause or Has_Suffix is true.
    --
    --  If the Interface is not present, or not used, the external name is the
    --  concatenation of:
@@ -428,22 +429,7 @@ package Exp_Dbug is
    --    - the string "$" (or "__" if target does not allow "$"), followed
    --        by homonym suffix, if the entity is an overloaded subprogram
    --        or is defined within an overloaded subprogram.
-
-   procedure Get_External_Name_With_Suffix
-     (Entity : Entity_Id;
-      Suffix : String);
-   --  Set Name_Buffer and Name_Len to the external name of entity E. If
-   --  Suffix is the empty string the external name is as above, otherwise
-   --  the external name is the concatenation of:
-   --
-   --    - the string "_ada_", if the entity is a library subprogram,
-   --    - the names of any enclosing scopes, each followed by "__",
-   --        or "X_" if the next entity is a subunit)
-   --    - the name of the entity
-   --    - the string "$" (or "__" if target does not allow "$"), followed
-   --        by homonym suffix, if the entity is an overloaded subprogram
-   --        or is defined within an overloaded subprogram.
-   --    - the string "___" followed by Suffix
+   --    - the string "___" followed by Suffix if Has_Suffix is true.
    --
    --  Note that a call to this procedure has no effect if we are not
    --  generating code, since the necessary information for computing the
Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 209671)
+++ exp_disp.adb	(working copy)
@@ -3913,10 +3913,7 @@ package body Exp_Disp is
 
          pragma Assert (Related_Type (Node (Elmt)) = Typ);
 
-         Get_External_Name
-           (Entity     => Node (Elmt),
-            Has_Suffix => True);
-
+         Get_External_Name (Node (Elmt));
          Set_Interface_Name (DT,
            Make_String_Literal (Loc,
              Strval => String_From_Name_Buffer));
@@ -7088,7 +7085,7 @@ package body Exp_Disp is
 
          Set_Scope (DT, Current_Scope);
 
-         Get_External_Name (DT, True);
+         Get_External_Name (DT);
          Set_Interface_Name (DT,
            Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
 
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 209684)
+++ gcc-interface/decl.c	(working copy)
@@ -8856,16 +8856,12 @@ get_entity_name (Entity_Id gnat_entity)
 tree
 create_concat_name (Entity_Id gnat_entity, const char *suffix)
 {
-  Entity_Kind kind = Ekind (gnat_entity);
+  const Entity_Kind kind = Ekind (gnat_entity);
+  const bool has_suffix = (suffix != NULL);
+  String_Template temp = { 1, has_suffix ? strlen (suffix) : 0 };
+  String_Pointer sp = {suffix, &temp};
 
-  if (suffix)
-    {
-      String_Template temp = {1, (int) strlen (suffix)};
-      Fat_Pointer fp = {suffix, &temp};
-      Get_External_Name_With_Suffix (gnat_entity, fp);
-    }
-  else
-    Get_External_Name (gnat_entity, 0);
+  Get_External_Name (gnat_entity, has_suffix, sp);
 
   /* A variable using the Stdcall convention lives in a DLL.  We adjust
      its name to use the jump table, the _imp__NAME contains the address
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 209684)
+++ gcc-interface/trans.c	(working copy)
@@ -9355,17 +9355,13 @@ decode_name (const char *name)
 void
 post_error (const char *msg, Node_Id node)
 {
-  String_Template temp;
-  Fat_Pointer fp;
+  if (Present (node))
+    {
+      String_Template temp = { 1, strlen (msg) };
+      String_Pointer sp = { msg, &temp };
 
-  if (No (node))
-    return;
-
-  temp.Low_Bound = 1;
-  temp.High_Bound = strlen (msg);
-  fp.Bounds = &temp;
-  fp.Array = msg;
-  Error_Msg_N (fp, node);
+      Error_Msg_N (sp, node);
+    }
 }
 
 /* Similar to post_error, but NODE is the node at which to post the error and
@@ -9374,17 +9370,13 @@ post_error (const char *msg, Node_Id nod
 void
 post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
 {
-  String_Template temp;
-  Fat_Pointer fp;
-
-  if (No (node))
-    return;
+  if (Present (node))
+    {
+      String_Template temp = { 1, strlen (msg) };
+      String_Pointer sp = { msg, &temp };
 
-  temp.Low_Bound = 1;
-  temp.High_Bound = strlen (msg);
-  fp.Bounds = &temp;
-  fp.Array = msg;
-  Error_Msg_NE (fp, node, ent);
+      Error_Msg_NE (sp, node, ent);
+    }
 }
 
 /* Similar to post_error_ne, but NUM is the number to use for the '^'.  */
Index: gcc-interface/misc.c
===================================================================
--- gcc-interface/misc.c	(revision 209684)
+++ gcc-interface/misc.c	(working copy)
@@ -283,7 +283,7 @@ internal_error_function (diagnostic_cont
   text_info tinfo;
   char *buffer, *p, *loc;
   String_Template temp, temp_loc;
-  Fat_Pointer fp, fp_loc;
+  String_Pointer fp, fp_loc;
   expanded_location s;
 
   /* Warn if plugins present.  */
@@ -325,7 +325,7 @@ internal_error_function (diagnostic_cont
   fp_loc.Array = loc;
 
   Current_Error_Node = error_gnat_node;
-  Compiler_Abort (fp, -1, fp_loc);
+  Compiler_Abort (fp, fp_loc, -1);
 }
 
 /* Perform all the initialization steps that are language-specific.  */
Index: exp_cg.adb
===================================================================
--- exp_cg.adb	(revision 209671)
+++ exp_cg.adb	(working copy)
@@ -437,10 +437,10 @@ package body Exp_CG is
       if Nkind (P) = N_Subprogram_Body
         and then not Acts_As_Spec (P)
       then
-         Get_External_Name (Corresponding_Spec (P), Has_Suffix => False);
+         Get_External_Name (Corresponding_Spec (P));
 
       else
-         Get_External_Name (Defining_Entity (P), Has_Suffix => False);
+         Get_External_Name (Defining_Entity (P));
       end if;
 
       Write_Str (Name_Buffer (1 .. Name_Len));

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]