2014-02-25 Robert Dewar <dewar@adacore.com>
+ * errout.adb: Various changes for better msgs for anonmous access
+ subprogram types.
+ * erroutc.ads, erroutc.adb (Buffer_Ends_With): Version with character
+ argument.
+ (Buffer_Remove): Version with character argument.
+ * sem_attr.adb (Resolve_Attribute, case Access): Better handling
+ of mismatching conventions for access-to-subprogram case.
+ * sem_prag.adb (Set_Convention_From_Pragma): Deal with anonymous
+ access types in record.
+ * sem_util.ads, sem_util.adb (Set_Convention): Handle anonymous access
+ types, including in records.
+
+2014-02-25 Doug Rupp <rupp@adacore.com>
+
+ * sigtramp-ppcvxw.c, sigtramp.h, sigtramp-armvxw.c: Comment
+ enhancements and corrections.
+
+2014-02-25 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: New section "Conventions and Anonymous Access Types"
+
+2014-02-25 Robert Dewar <dewar@adacore.com>
+
* gnat_rm.texi: First set of documentation additions for
predefined RM units.
* checks.adb: Minor reformatting.
procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id) is
begin
- -- Error message below needs rewording (remember comma in -gnatj
- -- mode) ???
-
Error_Msg_NE
("first formal of & must be of mode `OUT`, `IN OUT` or " &
"access-to-variable", Typ, Subp);
Set_Msg_Blank;
Set_Msg_Str ("procedure name");
+ elsif Nkind (Error_Msg_Node_1) in N_Entity
+ and then Ekind (Error_Msg_Node_1) = E_Anonymous_Access_Subprogram_Type
+ then
+ Set_Msg_Blank;
+ Set_Msg_Str ("access to subprogram");
+
else
Set_Msg_Blank_Conditional;
or else K = N_Operator_Symbol
or else K = N_Defining_Operator_Symbol
or else ((K = N_Identifier or else K = N_Defining_Identifier)
- and then Is_Operator_Name (Chars (Error_Msg_Node_1)))
+ and then Is_Operator_Name (Chars (Error_Msg_Node_1)))
then
Set_Msg_Node (Error_Msg_Node_1);
Get_Unqualified_Decoded_Name_String
(Unit_Name (Get_Source_Unit (Ent)));
Name_Len := Name_Len - 2;
+ Set_Msg_Blank_Conditional;
Set_Msg_Quote;
Set_Casing (Mixed_Case);
Set_Msg_Name_Buffer;
Set_Msg_Node (Ent);
Add_Class;
- -- If Ent is an anonymous subprogram type, there is no name to print,
- -- so remove enclosing quotes.
+ -- If we did not print a name (e.g. in the case of an anonymous
+ -- subprogram type), there is no name to print, so remove quotes.
- if Buffer_Ends_With ("""") then
- Buffer_Remove ("""");
+ if Buffer_Ends_With ('"') then
+ Buffer_Remove ('"');
else
Set_Msg_Quote;
end if;
end if;
-- If the type is the designated type of an access_to_subprogram,
- -- there is no name to provide in the call.
+ -- then there is no name to provide in the call.
if Ekind (Ent) = E_Subprogram_Type then
return;
+
+ -- Otherwise, we will be able to find some kind of name to output
+
else
Unwind_Internal_Type (Ent);
Nam := Chars (Ent);
if Buffer_Ends_With ("type ") then
Buffer_Remove ("type ");
end if;
+ end if;
- if Is_Itype (Ent) then
- declare
- Assoc : constant Node_Id :=
- Associated_Node_For_Itype (Ent);
-
- begin
- if Nkind (Assoc) in N_Subprogram_Specification then
-
- -- Anonymous access to subprogram in a signature.
- -- Indicate the enclosing subprogram.
-
- Ent :=
- Defining_Unit_Name
- (Associated_Node_For_Itype (Ent));
- Set_Msg_Str
- ("access to subprogram declared in profile of ");
-
- else
- Set_Msg_Str ("access to subprogram with profile ");
- end if;
- end;
- end if;
-
- elsif Ekind (Ent) = E_Function then
+ if Ekind (Ent) = E_Function then
Set_Msg_Str ("access to function ");
- else
+ elsif Ekind (Ent) = E_Procedure then
Set_Msg_Str ("access to procedure ");
+ else
+ Set_Msg_Str ("access to subprogram");
end if;
exit Find;
-- Buffer_Ends_With --
----------------------
+ function Buffer_Ends_With (C : Character) return Boolean is
+ begin
+ return Msglen > 0 and then Msg_Buffer (Msglen) = C;
+ end Buffer_Ends_With;
+
function Buffer_Ends_With (S : String) return Boolean is
Len : constant Natural := S'Length;
begin
- return
- Msglen > Len
- and then Msg_Buffer (Msglen - Len) = ' '
- and then Msg_Buffer (Msglen - Len + 1 .. Msglen) = S;
+ return Msglen > Len
+ and then Msg_Buffer (Msglen - Len) = ' '
+ and then Msg_Buffer (Msglen - Len + 1 .. Msglen) = S;
end Buffer_Ends_With;
-------------------
-- Buffer_Remove --
-------------------
+ procedure Buffer_Remove (C : Character) is
+ begin
+ if Buffer_Ends_With (C) then
+ Msglen := Msglen - 1;
+ end if;
+ end Buffer_Remove;
+
procedure Buffer_Remove (S : String) is
begin
if Buffer_Ends_With (S) then
procedure Add_Class;
-- Add 'Class to buffer for class wide type case (Class_Flag set)
+ function Buffer_Ends_With (C : Character) return Boolean;
+ -- Tests if message buffer ends with given character
+
function Buffer_Ends_With (S : String) return Boolean;
-- Tests if message buffer ends with given string preceded by a space
+ procedure Buffer_Remove (C : Character);
+ -- Remove given character fron end of buffer if it is present
+
procedure Buffer_Remove (S : String);
- -- Removes given string from end of buffer if it is present
- -- at end of buffer, and preceded by a space.
+ -- Removes given string from end of buffer if it is present at end of
+ -- buffer, and preceded by a space.
function Compilation_Errors return Boolean;
-- Returns true if errors have been detected, or warnings in -gnatwe
* Enumeration Clauses::
* Address Clauses::
* Effect of Convention on Representation::
+* Conventions and Anonymous Access Types::
* Determining the Representations chosen by GNAT::
@end menu
@end itemize
+@node Conventions and Anonymous Access Types
+@section Conventions and Anonymous Access Types
+@cindex Anonymous access types
+@cindex Convention for anonymous access types
+
+The RM is not entirely clear on convention handling in a number of cases,
+and in particular, it is not clear on the convention to be given to
+anonymous access types in general, and in particular what is to be
+done for the case of anonymous access-to-subprogram.
+
+In GNAT, we decide that if an explicit Convention is applied
+to an object or component, and its type is such an anonymous type,
+then the convention will apply to this anonymous type as well. This
+seems to make sense since it is anomolous in any case to have a
+different convention for an object and its type, and there is clearly
+no way to explicitly specify a convention for an anonymous type, since
+it doesn't have a name to specify!
+
+Furthermore, we decide that if a convention is applied to a record type,
+then this convention is inherited by any of its components that are of an
+anonymous access type which do not have an explicitly specified convention.
+
+The following program shows these conventions in action:
+
+@smallexample @c ada
+package ConvComp is
+ type Foo is range 1 .. 10;
+ type T1 is record
+ A : access function (X : Foo) return Integer;
+ B : Integer;
+ end record;
+ pragma Convention (C, T1);
+
+ type T2 is record
+ A : access function (X : Foo) return Integer;
+ pragma Convention (C, A);
+ B : Integer;
+ end record;
+ pragma Convention (COBOL, T2);
+
+ type T3 is record
+ A : access function (X : Foo) return Integer;
+ pragma Convention (COBOL, A);
+ B : Integer;
+ end record;
+ pragma Convention (C, T3);
+
+ type T4 is record
+ A : access function (X : Foo) return Integer;
+ B : Integer;
+ end record;
+ pragma Convention (COBOL, T4);
+
+ function F (X : Foo) return Integer;
+ pragma Convention (C, F);
+
+ function F (X : Foo) return Integer is (13);
+
+ TV1 : T1 := (F'Access, 12); -- OK
+ TV2 : T2 := (F'Access, 13); -- OK
+
+ TV3 : T3 := (F'Access, 13); -- ERROR
+ |
+>>> subprogram "F" has wrong convention
+>>> does not match access to subprogram declared at line 17
+ 38. TV4 : T4 := (F'Access, 13); -- ERROR
+ |
+>>> subprogram "F" has wrong convention
+>>> does not match access to subprogram declared at line 24
+ 39. end ConvComp;
+@end smallexample
+
@node Determining the Representations chosen by GNAT
@section Determining the Representations chosen by GNAT
@cindex Representation, determination of
then
Error_Msg_FE
("subprogram & has wrong convention", P, Entity (P));
- Error_Msg_FE
- ("\does not match convention of access type &",
- P, Btyp);
+ Error_Msg_Sloc := Sloc (Btyp);
+ Error_Msg_FE ("\does not match & declared#", P, Btyp);
- if not Has_Convention_Pragma (Btyp) then
+ if not Is_Itype (Btyp)
+ and then not Has_Convention_Pragma (Btyp)
+ then
Error_Msg_FE
("\probable missing pragma Convention for &",
P, Btyp);
Set_Convention (E, C);
Set_Has_Convention_Pragma (E);
+ -- For the case of a record base type, also set the convention of
+ -- any anonymous access types declared in the record which do not
+ -- currently have a specified convention.
+
+ if Is_Record_Type (E) and then Is_Base_Type (E) then
+ declare
+ Comp : Node_Id;
+
+ begin
+ Comp := First_Component (E);
+ while Present (Comp) loop
+ if Present (Etype (Comp))
+ and then Ekind_In (Etype (Comp),
+ E_Anonymous_Access_Type,
+ E_Anonymous_Access_Subprogram_Type)
+ and then not Has_Convention_Pragma (Comp)
+ then
+ Set_Convention (Comp, C);
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+ end;
+ end if;
+
+ -- Deal with incomplete/private type case, where underlying type
+ -- is available, so set convention of that underlying type.
+
if Is_Incomplete_Or_Private_Type (E)
and then Present (Underlying_Type (E))
then
then
Set_Can_Use_Internal_Rep (E, False);
end if;
+
+ -- If E is an object or component, and the type of E is an anonymous
+ -- access type with no convention set, then also set the convention of
+ -- the anonymous access type. We do not do this for anonymous protected
+ -- types, since protected types always have the default convention.
+
+ if Present (Etype (E))
+ and then (Is_Object (E)
+ or else Ekind (E) = E_Component
+
+ -- Allow E_Void (happens for pragma Convention appearing
+ -- in the middle of a record applying to a component)
+
+ or else Ekind (E) = E_Void)
+ then
+ declare
+ Typ : constant Entity_Id := Etype (E);
+
+ begin
+ if Ekind_In (Typ, E_Anonymous_Access_Type,
+ E_Anonymous_Access_Subprogram_Type)
+ and then not Has_Convention_Pragma (Typ)
+ then
+ Basic_Set_Convention (Typ, Val);
+ Set_Has_Convention_Pragma (Typ);
+
+ -- And for the access subprogram type, deal similarly with the
+ -- designated E_Subprogram_Type if it is also internal (which
+ -- it always is?)
+
+ if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then
+ declare
+ Dtype : constant Entity_Id := Designated_Type (Typ);
+ begin
+ if Ekind (Dtype) = E_Subprogram_Type
+ and then Is_Itype (Dtype)
+ and then not Has_Convention_Pragma (Dtype)
+ then
+ Basic_Set_Convention (Dtype, Val);
+ Set_Has_Convention_Pragma (Dtype);
+ end if;
+ end;
+ end if;
+ end if;
+ end;
+ end if;
end Set_Convention;
------------------------
-- Same as Basic_Set_Convention, but with an extra check for access types.
-- In particular, if E is an access-to-subprogram type, and Val is a
-- foreign convention, then we set Can_Use_Internal_Rep to False on E.
+ -- Also, if the Etype of E is set and is an anonymous access type with
+ -- no convention set, this anonymous type inherits the convention of E.
procedure Set_Current_Entity (E : Entity_Id);
pragma Inline (Set_Current_Entity);
******************************************************/
#include "sigtramp.h"
+/* See sigtramp.h for a general explanation of functionality. */
#include <vxWorks.h>
#include <arch/../regs.h>
#define REGNO_G_REG_OFFSET(N) (N)
-#define REGNO_PC_OFFSET 15 /* ARG_POINTER_REGNUM */
+#define REGNO_PC_OFFSET 15 /* PC_REGNUM */
/* asm string construction helpers. */
Only non-volatile registers are suitable for a CFA base. These are the
only ones we can expect to be able retrieve from the unwinding context
while walking up the chain, saved by at least the bottom-most exception
- propagation services. We use r15 here and set it to the value we need
- in stub body that follows. Note that r14 is inappropriate here, even
- though it is non-volatile according to the ABI, because GCC uses it as
- an extra SCRATCH on SPE targets. */
+ propagation services. We use r8 here and set it to the value we need
+ in stub body that follows. Any of r4-r8 should work. */
#define CFA_REG 8
Rules to find registers of interest from the CFA. This should comprise
all the non-volatile registers relevant to the interrupted context.
- Note that we include r1 in this set, unlike the libgcc unwinding
- fallbacks. This is useful for fallbacks to allow the use of r1 in CFI
- expressions and the absence of rule for r1 gets compensated by using the
- target CFA instead. We don't need the expression facility here and
- setup a fake CFA to allow very simple offset expressions, so having a
- rule for r1 is the proper thing to do. We for sure have observed
- crashes in some cases without it. */
+ ??? Note that r0 was excluded for consistency with the PPC version of
+ this file, not sure if that's right. */
#define COMMON_CFI(REG) \
".cfi_offset " S(REGNO_##REG) "," S(REG_SET_##REG)
**********************************************************/
#include "sigtramp.h"
+/* See sigtramp.h for a general explanation of functionality. */
#include <vxWorks.h>
#include <arch/../regs.h>
* *
* C Header File *
* *
- * Copyright (C) 2011, Free Software Foundation, Inc. *
+ * Copyright (C) 2011-2013, 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- *
/* To be called from an established signal handler. Setup the DWARF CFI
bits letting unwinders walk through the signal frame up into the
interrupted application code, and then call HANDLER (SIGNO, SIGINFO,
- SIGCONTEXT). */
+ SIGCONTEXT).
+
+ The sigtramp construct makes it so that the unwinder jumps over it + the
+ signal handler + the kernel frame. For a typical backtrace from the raise
+ function:
+
+ #0 __gnat_Unwind_RaiseException
+ #1 Raise_From_Signal_Handler
+ #2 __gnat_map_signal
+ #3 __gnat_sigtramp
+ #4 __gnat_error_handler
+ #5 <kernel frame>
+ #6 interrupted function
+
+ The unwinder will unwind frames 0, 1 and 2 as usual. But the CFI of frame
+ 3 is set up as if the caller of frame 3 was frame 6 so, when frame 3 is
+ unwound, the unwinder ends up in frame 6 directly. It's possible to do so
+ since the kernel has saved the context of frame 3 and passed it on to
+ __gnat_sigtramp. */
#ifdef __cplusplus
}
projects / platform / upstream / gcc.git / commitdiff