2014-04-28 Richard Henderson * gcc-interface/Makefile.in: Support aarch64-linux. 2014-04-28 Eric Botcazou * 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 * 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.adbshow_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) Raise_From_Signal_Handler (exception, msg); } -#if defined (i386) || defined (__x86_64__) || defined (__powerpc__) -/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. */ -char __gnat_alternate_stack[16 * 1024]; /* 2 * SIGSTKSZ */ +#ifndef __ia64__ +#define HAVE_GNAT_ALTERNATE_STACK 1 +/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size. + It must be larger than MINSIGSTKSZ and hopefully near 2 * SIGSTKSZ. */ +# if 16 * 1024 < MINSIGSTKSZ +# error "__gnat_alternate_stack too small" +# endif +char __gnat_alternate_stack[16 * 1024]; #endif #ifdef __XENO__ @@ -612,7 +617,7 @@ __gnat_install_handler (void) sigaction (SIGBUS, &act, NULL); if (__gnat_get_interrupt_state (SIGSEGV) != 's') { -#if defined (i386) || defined (__x86_64__) || defined (__powerpc__) +#ifdef HAVE_GNAT_ALTERNATE_STACK /* Setup an alternate stack region for the handler execution so that stack overflows can be handled properly, avoiding a SEGV generation from stack usage by the handler itself. */