+2014-05-13 Yvan Roux <yvan.roux@linaro.org>
+
+ Backport from trunk r209653,209866,209871.
+
+ 2014-04-28 Richard Henderson <rth@redhat.com>
+
+ * gcc-interface/Makefile.in: Support aarch64-linux.
+
+ 2014-04-28 Eric Botcazou <ebotcazou@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@redhat.com>
+
+ * init.c [__linux__] (HAVE_GNAT_ALTERNATE_STACK): New define.
+ (__gnat_alternate_stack): Enable for all linux except ia64.
+
2014-04-22 Yvan Roux <yvan.roux@linaro.org>
GCC Linaro 4.9-2014.04 released.
-- --
-- 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- --
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
Write_Str (") ");
if X'Length + Column > 76 then
- if Code < 0 then
+ if From_GCC then
Write_Str ("GCC error:");
end if;
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
-- --
-- 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- --
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.
-- 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
-- --
-- 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- --
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));
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
-- 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
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
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
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
-- 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;
-- 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
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 --
Suffix_Index : Int)
is
begin
- Get_External_Name (Typ, Has_Suffix => False);
+ Get_External_Name (Typ);
if Ancestor_Typ /= Typ then
declare
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
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:
-- - 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 --
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));
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));
* *
****************************************************************************/
-/* 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: */
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);
#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: */
#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: */
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 = \
#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.
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
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);
}
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 ();
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. */
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
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 '^'. */
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__
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. */
/* 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: */
projects / platform / upstream / gcc49.git / commitdiff