exp_dbug.ads (Get_External_Name): Add 'False' default to Has_Suffix, add 'Suffix' parameter and adjust comment.
* 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. From-SVN: r209866
This commit is contained in:
parent
9ba5fb4309
commit
9358288555
|
@ -1,3 +1,34 @@
|
|||
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-28 Richard Biener <rguenther@suse.de>
|
||||
|
||||
PR middle-end/60092
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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));
|
||||
|
||||
|
|
23
gcc/ada/fe.h
23
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: */
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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. */
|
||||
|
|
|
@ -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 '^'. */
|
||||
|
|
|
@ -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: */
|
||||
|
||||
|
|
Loading…
Reference in New Issue