[gcc] 4.9.0-5

Jakub Jelinek jakub at fedoraproject.org
Sun May 18 17:18:37 UTC 2014


commit 6d24375c6034257f58f25914779cc96a0d599722
Author: Jakub Jelinek <jakub at redhat.com>
Date:   Sun May 18 19:18:35 2014 +0200

    4.9.0-5

 gcc49-aarch64-ada.patch |  635 -----------------------------------------------
 1 files changed, 0 insertions(+), 635 deletions(-)
---
diff --git a/gcc49-aarch64-ada.patch b/gcc49-aarch64-ada.patch
index 3e3e41b..958bc40 100644
--- a/gcc49-aarch64-ada.patch
+++ b/gcc49-aarch64-ada.patch
@@ -1,643 +1,8 @@
-2014-04-28  Richard Henderson  <rth at redhat.com>
-
-	* gcc-interface/Makefile.in: Support aarch64-linux.
-
-2014-04-28  Eric Botcazou  <ebotcazou at adacore.com>
-
-	* exp_dbug.ads (Get_External_Name): Add 'False' default to Has_Suffix,
-	add 'Suffix' parameter and adjust comment.
-	(Get_External_Name_With_Suffix): Delete.
-	* exp_dbug.adb (Get_External_Name_With_Suffix): Merge into...
-	(Get_External_Name): ...here.  Add 'False' default to Has_Suffix, add
-	'Suffix' parameter.
-	(Get_Encoded_Name): Remove 2nd argument in call to Get_External_Name.
-	Call Get_External_Name instead of Get_External_Name_With_Suffix.
-	(Get_Secondary_DT_External_Name): Likewise.
-	* exp_cg.adb (Write_Call_Info): Likewise.
-	* exp_disp.adb (Export_DT): Likewise.
-	(Import_DT): Likewise.
-	* comperr.ads (Compiler_Abort): Remove Code parameter and add From_GCC
-	parameter with False default.
-	* comperr.adb (Compiler_Abort): Likewise.  Adjust accordingly.
-	* types.h (Fat_Pointer): Rename into...
-	(String_Pointer): ...this.  Add comment on interfacing rules.
-	* fe.h (Compiler_Abort): Adjust for above renaming.
-	(Error_Msg_N): Likewise.
-	(Error_Msg_NE): Likewise.
-	(Get_External_Name): Likewise.  Add third parameter.
-	(Get_External_Name_With_Suffix): Delete.
-	* gcc-interface/decl.c (STDCALL_PREFIX): Define.
-	(create_concat_name): Adjust call to Get_External_Name, remove call to
-	Get_External_Name_With_Suffix, use STDCALL_PREFIX, adjust for renaming.
-	* gcc-interface/trans.c (post_error): Likewise.
-	(post_error_ne): Likewise.
-	* gcc-interface/misc.c (internal_error_function): Likewise.
-
 2014-04-22  Richard Henderson  <rth at redhat.com>
 
 	* init.c [__linux__] (HAVE_GNAT_ALTERNATE_STACK): New define.
 	(__gnat_alternate_stack): Enable for all linux except ia64.
 
---- gcc/ada/comperr.adb
-+++ gcc/ada/comperr.adb
-@@ -6,7 +6,7 @@
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
----          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
-+--          Copyright (C) 1992-2014, 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- --
-@@ -74,8 +74,8 @@ package body Comperr is
- 
-    procedure Compiler_Abort
-      (X            : String;
--      Code         : Integer := 0;
--      Fallback_Loc : String := "")
-+      Fallback_Loc : String  := "";
-+      From_GCC     : Boolean := False)
-    is
-       --  The procedures below output a "bug box" with information about
-       --  the cause of the compiler abort and about the preferred method
-@@ -206,7 +206,7 @@ package body Comperr is
-          Write_Str (") ");
- 
-          if X'Length + Column > 76 then
--            if Code < 0 then
-+            if From_GCC then
-                Write_Str ("GCC error:");
-             end if;
- 
-@@ -235,11 +235,7 @@ package body Comperr is
-             Write_Str (X);
-          end if;
- 
--         if Code > 0 then
--            Write_Str (", Code=");
--            Write_Int (Int (Code));
--
--         elsif Code = 0 then
-+         if not From_GCC then
- 
-             --  For exception case, get exception message from the TSD. Note
-             --  that it would be neater and cleaner to pass the exception
---- gcc/ada/comperr.ads
-+++ gcc/ada/comperr.ads
-@@ -6,7 +6,7 @@
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
----          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
-+--          Copyright (C) 1992-2014, 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- --
-@@ -31,8 +31,8 @@ package Comperr is
- 
-    procedure Compiler_Abort
-      (X            : String;
--      Code         : Integer := 0;
--      Fallback_Loc : String := "");
-+      Fallback_Loc : String  := "";
-+      From_GCC     : Boolean := False);
-    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.
-@@ -46,10 +46,9 @@ package Comperr is
-    --  Note that this is only used at the outer level (to handle constraint
-    --  errors or assert errors etc.) In the normal logic of the compiler we
-    --  always use pragma Assert to check for errors, and if necessary an
--   --  explicit abort is achieved by pragma Assert (False). Code is positive
--   --  for a gigi abort (giving the gigi abort code), zero for a front
--   --  end exception (with possible message stored in TSD.Current_Excep,
--   --  and negative (an unused value) for a GCC abort.
-+   --  explicit abort is achieved by pragma Assert (False). From_GCC is true
-+   --  for a GCC abort and false for a front end exception (with a possible
-+   --  message stored in TSD.Current_Excep).
- 
-    procedure Delete_SCIL_Files;
-    --  Delete SCIL files associated with the main unit
---- gcc/ada/exp_cg.adb
-+++ gcc/ada/exp_cg.adb
-@@ -6,7 +6,7 @@
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
----          Copyright (C) 2010-2013, Free Software Foundation, Inc.         --
-+--          Copyright (C) 2010-2014, 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- --
-@@ -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));
---- gcc/ada/exp_dbug.adb
-+++ gcc/ada/exp_dbug.adb
-@@ -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
---- gcc/ada/exp_dbug.ads
-+++ gcc/ada/exp_dbug.ads
-@@ -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 the 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,26 +429,11 @@ 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
--   --  proper encoded name is not available in this case.
-+   --  proper external name is not available in this case.
- 
-    --------------------------------------------
-    -- Subprograms for Handling Qualification --
---- gcc/ada/exp_disp.adb
-+++ gcc/ada/exp_disp.adb
-@@ -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));
- 
---- gcc/ada/fe.h
-+++ gcc/ada/fe.h
-@@ -29,17 +29,20 @@
-  *                                                                          *
-  ****************************************************************************/
- 
--/* This file contains definitions to access front-end functions and
--   variables used by gigi.  */
-+/* This file contains declarations to access front-end functions and variables
-+   used by gigi.
-+
-+   WARNING: functions taking String_Pointer parameters must abide by the rule
-+   documented alongside the definition of String_Pointer in types.h.  */
- 
- #ifdef __cplusplus
- extern "C" {
- #endif
- 
--/* comperr:  */
-+/* 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, Boolean) ATTRIBUTE_NORETURN;
- 
- /* csets: */
- 
-@@ -72,8 +75,6 @@ extern void Set_Mechanism		(Entity_Id, Mechanism_Type);
- extern void Set_RM_Size			(Entity_Id, Uint);
- extern void Set_Present_Expr		(Node_Id, Uint);
- 
--/* Test if the node N is the name of an entity (i.e. is an identifier,
--   expanded name, or an attribute reference that returns an entity).  */
- #define Is_Entity_Name einfo__is_entity_name
- extern Boolean Is_Entity_Name		(Node_Id);
- 
-@@ -90,8 +91,8 @@ extern Node_Id Get_Attribute_Definition_Clause (Entity_Id, char);
- #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 +148,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: */
- 
---- gcc/ada/gcc-interface/Makefile.in
-+++ gcc/ada/gcc-interface/Makefile.in
-@@ -1988,6 +1988,44 @@ ifeq ($(strip $(filter-out arm% linux-gnueabi%,$(target_cpu) $(target_os))),)
-   LIBRARY_VERSION := $(LIB_VERSION)
- endif
- 
-+# AArch64 Linux
-+ifeq ($(strip $(filter-out aarch64% linux%,$(target_cpu) $(target_os))),)
-+  LIBGNAT_TARGET_PAIRS = \
-+  a-exetim.adb<a-exetim-posix.adb \
-+  a-exetim.ads<a-exetim-default.ads \
-+  a-intnam.ads<a-intnam-linux.ads \
-+  a-synbar.adb<a-synbar-posix.adb \
-+  a-synbar.ads<a-synbar-posix.ads \
-+  s-inmaop.adb<s-inmaop-posix.adb \
-+  s-intman.adb<s-intman-posix.adb \
-+  s-linux.ads<s-linux.ads \
-+  s-mudido.adb<s-mudido-affinity.adb \
-+  s-osinte.ads<s-osinte-linux.ads \
-+  s-osinte.adb<s-osinte-posix.adb \
-+  s-osprim.adb<s-osprim-posix.adb \
-+  s-taprop.adb<s-taprop-linux.adb \
-+  s-tasinf.ads<s-tasinf-linux.ads \
-+  s-tasinf.adb<s-tasinf-linux.adb \
-+  s-tpopsp.adb<s-tpopsp-tls.adb \
-+  s-taspri.ads<s-taspri-posix.ads \
-+  g-sercom.adb<g-sercom-linux.adb \
-+  $(ATOMICS_TARGET_PAIRS) \
-+  $(ATOMICS_BUILTINS_TARGET_PAIRS) \
-+  system.ads<system-linux-x86_64.ads
-+  ## ^^ Note the above is a pretty-close placeholder.
-+
-+  TOOLS_TARGET_PAIRS =  \
-+    mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
-+    indepsw.adb<indepsw-gnu.adb
-+
-+  EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
-+  EH_MECHANISM=-gcc
-+  THREADSLIB=-lpthread -lrt
-+  GNATLIB_SHARED=gnatlib-shared-dual
-+  GMEM_LIB = gmemlib
-+  LIBRARY_VERSION := $(LIB_VERSION)
-+endif
-+
- # Sparc Linux
- ifeq ($(strip $(filter-out sparc% linux%,$(target_cpu) $(target_os))),)
-   LIBGNAT_TARGET_PAIRS_COMMON = \
---- gcc/ada/gcc-interface/decl.c
-+++ gcc/ada/gcc-interface/decl.c
-@@ -72,6 +72,8 @@
- #define Has_Thiscall_Convention(E) 0
- #endif
- 
-+#define STDCALL_PREFIX "_imp__"
-+
- /* Stack realignment is necessary for functions with foreign conventions when
-    the ABI doesn't mandate as much as what the compiler assumes - that is, up
-    to PREFERRED_STACK_BOUNDARY.
-@@ -8856,16 +8858,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
-@@ -8873,9 +8871,9 @@ create_concat_name (Entity_Id gnat_entity, const char *suffix)
-   if ((kind == E_Variable || kind == E_Constant)
-       && Has_Stdcall_Convention (gnat_entity))
-     {
--      const int len = 6 + Name_Len;
-+      const int len = strlen (STDCALL_PREFIX) + Name_Len;
-       char *new_name = (char *) alloca (len + 1);
--      strcpy (new_name, "_imp__");
-+      strcpy (new_name, STDCALL_PREFIX);
-       strcat (new_name, Name_Buffer);
-       return get_identifier_with_length (new_name, len);
-     }
---- gcc/ada/gcc-interface/misc.c
-+++ gcc/ada/gcc-interface/misc.c
-@@ -283,8 +283,8 @@ internal_error_function (diagnostic_context *context,
-   text_info tinfo;
-   char *buffer, *p, *loc;
-   String_Template temp, temp_loc;
--  Fat_Pointer fp, fp_loc;
--  expanded_location s;
-+  String_Pointer sp, sp_loc;
-+  expanded_location xloc;
- 
-   /* Warn if plugins present.  */
-   warn_if_plugins ();
-@@ -311,21 +311,21 @@ internal_error_function (diagnostic_context *context,
- 
-   temp.Low_Bound = 1;
-   temp.High_Bound = p - buffer;
--  fp.Bounds = &temp;
--  fp.Array = buffer;
-+  sp.Bounds = &temp;
-+  sp.Array = buffer;
- 
--  s = expand_location (input_location);
--  if (context->show_column && s.column != 0)
--    asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
-+  xloc = expand_location (input_location);
-+  if (context->show_column && xloc.column != 0)
-+    asprintf (&loc, "%s:%d:%d", xloc.file, xloc.line, xloc.column);
-   else
--    asprintf (&loc, "%s:%d", s.file, s.line);
-+    asprintf (&loc, "%s:%d", xloc.file, xloc.line);
-   temp_loc.Low_Bound = 1;
-   temp_loc.High_Bound = strlen (loc);
--  fp_loc.Bounds = &temp_loc;
--  fp_loc.Array = loc;
-+  sp_loc.Bounds = &temp_loc;
-+  sp_loc.Array = loc;
- 
-   Current_Error_Node = error_gnat_node;
--  Compiler_Abort (fp, -1, fp_loc);
-+  Compiler_Abort (sp, sp_loc, true);
- }
- 
- /* Perform all the initialization steps that are language-specific.  */
---- gcc/ada/gcc-interface/trans.c
-+++ gcc/ada/gcc-interface/trans.c
-@@ -9356,16 +9356,16 @@ void
- post_error (const char *msg, Node_Id node)
- {
-   String_Template temp;
--  Fat_Pointer fp;
-+  String_Pointer sp;
- 
-   if (No (node))
-     return;
- 
-   temp.Low_Bound = 1;
-   temp.High_Bound = strlen (msg);
--  fp.Bounds = &temp;
--  fp.Array = msg;
--  Error_Msg_N (fp, node);
-+  sp.Bounds = &temp;
-+  sp.Array = msg;
-+  Error_Msg_N (sp, node);
- }
- 
- /* Similar to post_error, but NODE is the node at which to post the error and
-@@ -9375,16 +9375,16 @@ void
- post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
- {
-   String_Template temp;
--  Fat_Pointer fp;
-+  String_Pointer sp;
- 
-   if (No (node))
-     return;
- 
-   temp.Low_Bound = 1;
-   temp.High_Bound = strlen (msg);
--  fp.Bounds = &temp;
--  fp.Array = msg;
--  Error_Msg_NE (fp, node, ent);
-+  sp.Bounds = &temp;
-+  sp.Array = msg;
-+  Error_Msg_NE (sp, node, ent);
- }
- 
- /* Similar to post_error_ne, but NUM is the number to use for the '^'.  */
---- gcc/ada/types.h
-+++ gcc/ada/types.h
-@@ -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:  */
-
 --- gcc/ada/init.c
 +++ gcc/ada/init.c
 @@ -556,9 +556,14 @@ __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)


More information about the scm-commits mailing list