-- needed, but in fact, in Ada 2005 the subprogram may be used in a call-
-- back, and therefore a protected version of the operation must be
-- generated as well.
+ --
+ -- Possibly factor this with Exp_Dist.Copy_Specification ???
function Build_Protected_Sub_Specification
(N : Node_Id;
------------------------
function Copy_Specification
- (Loc : Source_Ptr;
- Spec : Node_Id;
- Ctrl_Type : Entity_Id := Empty;
- New_Name : Name_Id := No_Name) return Node_Id
+ (Loc : Source_Ptr;
+ Spec : Node_Id;
+ Ctrl_Type : Entity_Id := Empty;
+ New_Name : Name_Id := No_Name) return Node_Id
is
Parameters : List_Id := No_List;
-- Build a literal representing the remote subprogram identifier of E
function Copy_Specification
- (Loc : Source_Ptr;
- Spec : Node_Id;
- Ctrl_Type : Entity_Id := Empty;
- New_Name : Name_Id := No_Name) return Node_Id;
+ (Loc : Source_Ptr;
+ Spec : Node_Id;
+ Ctrl_Type : Entity_Id := Empty;
+ New_Name : Name_Id := No_Name) return Node_Id;
-- Build a subprogram specification from another one, or from an
-- access-to-subprogram definition. If Ctrl_Type is not Empty, and any
-- controlling formal of an anonymous access type is found, then it is
-- replaced by an access to Ctrl_Type. If New_Name is given, then it will
-- be used as the name for the newly created spec.
+ --
+ -- Possibly factor this wrt Exp_Ch9.Build_Private_Protected_Declaration???
function Corresponding_Stub_Type (RACW_Type : Entity_Id) return Entity_Id;
-- Return the stub type associated with the given RACW type
* Pragma Remote_Access_Type::
* Pragma Restricted_Run_Time::
* Pragma Restriction_Warnings::
+* Pragma Reviewable::
* Pragma Share_Generic::
* Pragma Shared::
* Pragma Short_Circuit_And_Or::
* Pragma Remote_Access_Type::
* Pragma Restricted_Run_Time::
* Pragma Restriction_Warnings::
+* Pragma Reviewable::
* Pragma Share_Generic::
* Pragma Shared::
* Pragma Short_Circuit_And_Or::
generating a warning, but any other use of implementation
defined pragmas will cause a warning to be generated.
+@node Pragma Reviewable
+@unnumberedsec Pragma Reviewable
+@findex Reviewable
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Reviewable;
+@end smallexample
+
+@noindent
+This pragma is an RM-defined standard pragma, but has no effect on the
+program being compiled, or on the code generated for the program.
+
+To obtain the required output specified in RM H.3.1, the compiler must be
+run with various special switches as follows:
+
+@table @i
+
+@item Where compiler-generated run-time checks remain
+
+The switch @option{-gnatGL}
+@findex @option{-gnatGL}
+may be used to list the expanded code in pseudo-Ada form.
+Runtime checks show up in the listing either as explicit
+checks or operators marked with @{@} to indicate a check is present.
+
+@item An identification of known exceptions at compile time
+
+If the program is compiled with @option{-gnatwa},
+@findex @option{-gnatwa}
+the compiler warning messages will indicate all cases where the compiler
+detects that an exception is certain to occur at run time.
+
+@item Possible reads of uninitialized variables
+
+The compiler warns of many such cases, but its output is incomplete.
+@ifclear FSFEDITION
+The CodePeer analysis tool
+@findex CodePeer static analysis tool
+@end ifclear
+@ifset FSFEDITION
+A supplemental static analysis tool
+@end ifset
+may be used to obtain a comprehensive list of all
+possible points at which uninitialized data may be read.
+
+@item Where run-time support routines are implicitly invoked
+
+In the output from @option{-gnatGL},
+@findex @option{-gnatGL}
+run-time calls are explicitly listed as calls to the relevant
+run-time routine.
+
+@item Object code listing
+
+This may be obtained either by using the @option{-S} switch,
+@findex @option{-S}
+or the objdump utility.
+@findex objdump
+
+@item Constructs known to be erroneous at compile time
+
+These are identified by warnings issued by the compiler (use @option{-gnatwa}).
+@findex @option{-gnatwa}
+
+@item Stack usage information
+
+Static stack usage data (maximum per-subprogram) can be obtained via the
+@option{-fstack-usage} switch to the compiler.
+@findex @option{-fstack-usage}
+Dynamic stack usage data (per task) can be obtained via the @option{-u} switch
+to gnatbind
+@findex @option{-u}
+@ifclear FSFEDITION
+The gnatstack utility
+@findex gnatstack
+can be used to provide additional information on stack usage.
+@end ifclear
+
+@item Object code listing of entire partition
+
+This can be obtained by compiling the partition with @option{-S},
+@findex @option{-S}
+or by applying objdump
+@findex objdump
+to all the object files that are part of the partition.
+
+@item A description of the run-time model
+
+The full sources of the run-time are available, and the documentation of
+these routines describes how these run-time routines interface to the
+underlying operating system facilities.
+
+@item Control and data-flow information
+
+@ifclear FSFEDITION
+The CodePeer tool
+@findex CodePeer static analysis tool
+@end ifclear
+@ifset FSFEDITION
+A supplemental static analysis tool
+@end ifset
+may be used to obtain complete control and data-flow information, as well as
+comprehensive messages identifying possible problems based on this
+information.
+@end table
+
@node Pragma Share_Generic
@unnumberedsec Pragma Share_Generic
@findex Share_Generic
@item Ada.Strings.Bounded.Equal_Case_Insensitive (A.4.10)
Provides case-insensitive comparisons of bounded strings
+@item Ada.Strings.Bounded.Hash (A.4.9)
+This package provides a generic hash function for bounded strings
+
+@item Ada.Strings.Bounded.Hash_Case_Insensitive (A.4.9)
+This package provides a generic hash function for bounded strings that
+converts the string to be hashed to lower case.
+
+@item Ada.Strings.Bounded.Less_Case_Insensitive (A.4.10)
+This package provides a comparison function for bounded strings that works
+in a case insensitive manner by converting to lower case before the comparison.
+
@item Ada.Strings.Fixed (A.4.3)
This package provides facilities for handling fixed length strings.
+@item Ada.Strings.Fixed.Equal_Case_Insensitive (A.4.10)
+This package provides an equality function for fixed strings that compares
+the strings after converting both to lower case.
+
+@item Ada.Strings.Fixed.Hash_Case_Insensitive (A.4.9)
+This package provides a case insensitive hash function for fixed strings that
+converts the string to lower case before computing the hash.
+
+@item Ada.Strings.Fixed.Less_Case_Insensitive (A.4.10)
+This package provides a comparison function for fixed strings that works
+in a case insensitive manner by converting to lower case before the comparison.
+
+Ada.Strings.Hash (A.4.9)
+This package provides a hash function for strings.
+
+Ada.Strings.Hash_Case_Insensitive (A.4.9)
+This package provides a hash function for strings that is case insensitive.
+The string is converted to lower case before computing the hash.
+
+@item Ada.Strings.Less_Case_Insensitive (A.4.10)
+This package provides a comparison function for\strings that works
+in a case insensitive manner by converting to lower case before the comparison.
+
@item Ada.Strings.Maps (A.4.2)
This package provides facilities for handling character mappings and
arbitrarily defined subsets of characters. For instance it is useful in
strings. The unbounded model allows arbitrary length strings, but
requires the use of dynamic allocation and finalization.
+@item Ada.Strings.Unbounded.Equal_Case_Insensitive (A.4.10)
+Provides case-insensitive comparisons of unbounded strings
+
+@item Ada.Strings.Unbounded.Hash (A.4.9)
+This package provides a generic hash function for unbounded strings
+
+@item Ada.Strings.Unbounded.Hash_Case_Insensitive (A.4.9)
+This package provides a generic hash function for unbounded strings that
+converts the string to be hashed to lower case.
+
+@item Ada.Strings.Unbounded.Less_Case_Insensitive (A.4.10)
+This package provides a comparison function for unbounded strings that works
+in a case insensitive manner by converting to lower case before the comparison.
+
+@item Ada.Strings.UTF_Encoding (A.4.11)
+This package provides basic definitions for dealing with UTF-encoded strings.
+
+@item Ada.Strings.UTF_Encoding.Conversions (A.4.11)
+This package provides conversion functions for UTF-encoded strings.
+
+@item Ada.Strings.UTF_Encoding.Strings (A.4.11)
+@itemx Ada.Strings.UTF_Encoding.Wide_Strings (A.4.11)
+@itemx Ada.Strings.UTF_Encoding.Wide_Wide_Strings (A.4.11)
+These packages provide facilities for handling UTF encodings for
+Strings, Wide_Strings and Wide_Wide_Strings.
+
@item Ada.Strings.Wide_Bounded (A.4.7)
@itemx Ada.Strings.Wide_Fixed (A.4.7)
@itemx Ada.Strings.Wide_Maps (A.4.7)
-@itemx Ada.Strings.Wide_Maps.Constants (A.4.7)
@itemx Ada.Strings.Wide_Unbounded (A.4.7)
These packages provide analogous capabilities to the corresponding
packages without @samp{Wide_} in the name, but operate with the types
@code{Wide_String} and @code{Wide_Character} instead of @code{String}
-and @code{Character}.
+and @code{Character}. Versions of all the child packages are available.
@item Ada.Strings.Wide_Wide_Bounded (A.4.7)
@itemx Ada.Strings.Wide_Wide_Fixed (A.4.7)
@itemx Ada.Strings.Wide_Wide_Maps (A.4.7)
-@itemx Ada.Strings.Wide_Wide_Maps.Constants (A.4.7)
@itemx Ada.Strings.Wide_Wide_Unbounded (A.4.7)
These packages provide analogous capabilities to the corresponding
packages without @samp{Wide_} in the name, but operate with the types
@code{Wide_Wide_String} and @code{Wide_Wide_Character} instead
of @code{String} and @code{Character}.
+@item Ada.Synchronous_Barriers (D.10.1)
+This package provides facilities for synchronizing tasks at a low level
+with barriers.
+
@item Ada.Synchronous_Task_Control (D.10)
This package provides some standard facilities for controlling task
communication in a synchronous manner.
+@item Ada.Synchronous_Task_Control.EDF (D.10)
+Not implemented in GNAT.
+
@item Ada.Tags
This package contains definitions for manipulation of the tags of tagged
values.
-@item Ada.Task_Attributes
+@item Ada.Tags.Generic_Dispatching_Constructor (3.9)
+This package provides a way of constructing tagged class-wide values given
+only the tag value.
+
+@item Ada.Task_Attributes (C.7.2)
This package provides the capability of associating arbitrary
task-specific data with separate tasks.
+@item Ada.Task_Identifification (C.7.1)
+This package provides capabilities for task identification.
+
+@item Ada.Task_Termination (C.7.3)
+This package provides control over task termination.
+
@item Ada.Text_IO
This package provides basic text input-output capabilities for
character, string and numeric data. The subpackages of this
-package are listed next.
+package are listed next. Note that although these are defined
+as subpackages in the RM, they are actually transparently
+implemented as child packages in GNAT, meaning that they
+are only loaded if needed.
@item Ada.Text_IO.Decimal_IO
Provides input-output facilities for decimal fixed-point types
@end table
@item Ada.Text_IO.Modular_IO
-Provides input-output facilities for modular (unsigned) types
+Provides input-output facilities for modular (unsigned) types.
+
+@item Ada.Text_IO.Bounded_IO (A.10.11)
+Provides input-output facilities for bounded strings.
@item Ada.Text_IO.Complex_IO (G.1.3)
This package provides basic text input-output capabilities for complex
as streams, so that the stream attributes can be used for writing
arbitrary data, including binary data, to Text_IO files.
+@item Ada.Text_IO.Unbounded_IO (A.10.12)
+This package provides input-output facilities for unbounded strings.
+
@item Ada.Unchecked_Conversion (13.9)
This generic package allows arbitrary conversion from one type to
another of the same size, providing for breaking the type safety in
This package is similar to @code{Ada.Text_IO}, except that the external
file supports wide character representations, and the internal types are
@code{Wide_Character} and @code{Wide_String} instead of @code{Character}
-and @code{String}. It contains generic subpackages listed next.
-
-@item Ada.Wide_Text_IO.Decimal_IO
-Provides input-output facilities for decimal fixed-point types
-
-@item Ada.Wide_Text_IO.Enumeration_IO
-Provides input-output facilities for enumeration types.
-
-@item Ada.Wide_Text_IO.Fixed_IO
-Provides input-output facilities for ordinary fixed-point types.
-
-@item Ada.Wide_Text_IO.Float_IO
-Provides input-output facilities for float types. The following
-predefined instantiations of this generic package are available:
-
-@table @code
-@item Short_Float
-@code{Short_Float_Wide_Text_IO}
-@item Float
-@code{Float_Wide_Text_IO}
-@item Long_Float
-@code{Long_Float_Wide_Text_IO}
-@end table
-
-@item Ada.Wide_Text_IO.Integer_IO
-Provides input-output facilities for integer types. The following
-predefined instantiations of this generic package are available:
-
-@table @code
-@item Short_Short_Integer
-@code{Ada.Short_Short_Integer_Wide_Text_IO}
-@item Short_Integer
-@code{Ada.Short_Integer_Wide_Text_IO}
-@item Integer
-@code{Ada.Integer_Wide_Text_IO}
-@item Long_Integer
-@code{Ada.Long_Integer_Wide_Text_IO}
-@item Long_Long_Integer
-@code{Ada.Long_Long_Integer_Wide_Text_IO}
-@end table
-
-@item Ada.Wide_Text_IO.Modular_IO
-Provides input-output facilities for modular (unsigned) types
-
-@item Ada.Wide_Text_IO.Complex_IO (G.1.3)
-This package is similar to @code{Ada.Text_IO.Complex_IO}, except that the
-external file supports wide character representations.
-
-@item Ada.Wide_Text_IO.Editing (F.3.4)
-This package is similar to @code{Ada.Text_IO.Editing}, except that the
-types are @code{Wide_Character} and @code{Wide_String} instead of
-@code{Character} and @code{String}.
-
-@item Ada.Wide_Text_IO.Streams (A.12.3)
-This package is similar to @code{Ada.Text_IO.Streams}, except that the
-types are @code{Wide_Character} and @code{Wide_String} instead of
-@code{Character} and @code{String}.
+and @code{String}. The corresponding set of nested packages and child
+packages are defined.
@item Ada.Wide_Wide_Text_IO (A.11)
This package is similar to @code{Ada.Text_IO}, except that the external
file supports wide character representations, and the internal types are
@code{Wide_Character} and @code{Wide_String} instead of @code{Character}
-and @code{String}. It contains generic subpackages listed next.
+and @code{String}. The corresponding set of nested packages and child
+packages are defined.
-@item Ada.Wide_Wide_Text_IO.Decimal_IO
-Provides input-output facilities for decimal fixed-point types
-
-@item Ada.Wide_Wide_Text_IO.Enumeration_IO
-Provides input-output facilities for enumeration types.
-
-@item Ada.Wide_Wide_Text_IO.Fixed_IO
-Provides input-output facilities for ordinary fixed-point types.
-
-@item Ada.Wide_Wide_Text_IO.Float_IO
-Provides input-output facilities for float types. The following
-predefined instantiations of this generic package are available:
-
-@table @code
-@item Short_Float
-@code{Short_Float_Wide_Wide_Text_IO}
-@item Float
-@code{Float_Wide_Wide_Text_IO}
-@item Long_Float
-@code{Long_Float_Wide_Wide_Text_IO}
-@end table
-
-@item Ada.Wide_Wide_Text_IO.Integer_IO
-Provides input-output facilities for integer types. The following
-predefined instantiations of this generic package are available:
-
-@table @code
-@item Short_Short_Integer
-@code{Ada.Short_Short_Integer_Wide_Wide_Text_IO}
-@item Short_Integer
-@code{Ada.Short_Integer_Wide_Wide_Text_IO}
-@item Integer
-@code{Ada.Integer_Wide_Wide_Text_IO}
-@item Long_Integer
-@code{Ada.Long_Integer_Wide_Wide_Text_IO}
-@item Long_Long_Integer
-@code{Ada.Long_Long_Integer_Wide_Wide_Text_IO}
@end table
-@item Ada.Wide_Wide_Text_IO.Modular_IO
-Provides input-output facilities for modular (unsigned) types
-
-@item Ada.Wide_Wide_Text_IO.Complex_IO (G.1.3)
-This package is similar to @code{Ada.Text_IO.Complex_IO}, except that the
-external file supports wide character representations.
-
-@item Ada.Wide_Wide_Text_IO.Editing (F.3.4)
-This package is similar to @code{Ada.Text_IO.Editing}, except that the
-types are @code{Wide_Character} and @code{Wide_String} instead of
-@code{Character} and @code{String}.
-
-@item Ada.Wide_Wide_Text_IO.Streams (A.12.3)
-This package is similar to @code{Ada.Text_IO.Streams}, except that the
-types are @code{Wide_Character} and @code{Wide_String} instead of
-@code{Character} and @code{String}.
-@end table
+For packages in Interfaces and System, all the RM defined packages are
+available in GNAT, see the Ada 2012 RM for full details.
@node The Implementation of Standard I/O
@chapter The Implementation of Standard I/O
sigdelset (&mask, sig);
sigprocmask (SIG_SETMASK, &mask, NULL);
-#if defined (__PPC__) && defined(_WRS_KERNEL)
+#if (defined (__ARMEL__) || defined (__PPC__)) && defined(_WRS_KERNEL)
/* On PowerPC, kernel mode, we process signals through a Call Frame Info
trampoline, voiding the need for myriads of fallback_frame_state
variants in the ZCX runtime. We have no simple way to distinguish ZCX
if Ekind (Ent) = E_In_Parameter then
Error_Msg_N
("assignment to IN mode parameter not allowed", N);
+ return;
-- Renamings of protected private components are turned into
-- constants when compiling a protected function. In the case
then
Error_Msg_N
("protected function cannot modify protected object", N);
+ return;
elsif Ekind (Ent) = E_Loop_Parameter then
- Error_Msg_N
- ("assignment to loop parameter not allowed", N);
-
- else
- Error_Msg_N
- ("left hand side of assignment must be a variable", N);
+ Error_Msg_N ("assignment to loop parameter not allowed", N);
+ return;
end if;
end;
- -- For indexed components or selected components, test prefix
+ -- For indexed components, test prefix if it is in array. We do not
+ -- want to recurse for cases where the prefix is a pointer, since we
+ -- may get a message confusing the pointer and what it references.
- elsif Nkind (N) = N_Indexed_Component then
+ elsif Nkind (N) = N_Indexed_Component
+ and then Is_Array_Type (Etype (Prefix (N)))
+ then
Diagnose_Non_Variable_Lhs (Prefix (N));
+ return;
-- Another special case for assignment to discriminant
if Present (Entity (Selector_Name (N)))
and then Ekind (Entity (Selector_Name (N))) = E_Discriminant
then
- Error_Msg_N
- ("assignment to discriminant not allowed", N);
- else
+ Error_Msg_N ("assignment to discriminant not allowed", N);
+ return;
+
+ -- For selection from record, diagnose prefix, but note that again
+ -- we only do this for a record, not e.g. for a pointer.
+
+ elsif Is_Record_Type (Etype (Prefix (N))) then
Diagnose_Non_Variable_Lhs (Prefix (N));
+ return;
end if;
+ end if;
- else
- -- If we fall through, we have no special message to issue
+ -- If we fall through, we have no special message to issue
- Error_Msg_N ("left hand side of assignment must be a variable", N);
- end if;
+ Error_Msg_N ("left hand side of assignment must be a variable", N);
end Diagnose_Non_Variable_Lhs;
--------------
Stm : Node_Id;
Kind : Node_Kind;
+ function Assert_False return Boolean;
+ -- Returns True if Last_Stm is a pragma Assert (False) that has been
+ -- rewritten as a null statement when assertions are off. The assert
+ -- is not active, but it is still enough to kill the warning.
+
+ ------------------
+ -- Assert_False --
+ ------------------
+
+ function Assert_False return Boolean is
+ Orig : constant Node_Id := Original_Node (Last_Stm);
+
+ begin
+ if Nkind (Orig) = N_Pragma
+ and then Pragma_Name (Orig) = Name_Assert
+ and then not Error_Posted (Orig)
+ then
+ declare
+ Arg : constant Node_Id :=
+ First (Pragma_Argument_Associations (Orig));
+ Exp : constant Node_Id := Expression (Arg);
+ begin
+ return Nkind (Exp) = N_Identifier
+ and then Chars (Exp) = Name_False;
+ end;
+
+ else
+ return False;
+ end if;
+ end Assert_False;
+
+ -- Local variables
+
Raise_Exception_Call : Boolean;
-- Set True if statement sequence terminated by Raise_Exception call
-- or a Reraise_Occurrence call.
+ -- Start of processing for Check_Statement_Sequence
+
begin
Raise_Exception_Call := False;
-- If we fall through, issue appropriate message
if Mode = 'F' then
- if not Raise_Exception_Call then
+
+ -- Kill warning if last statement is a raise exception call,
+ -- or a pragma Assert (False). Note that with assertions enabled,
+ -- such a pragma has been converted into a raise exception call
+ -- already, so the Assert_False is for the assertions off case.
+
+ if not Raise_Exception_Call and then not Assert_False then
-- In GNATprove mode, it is an error to have a missing return
Error_Msg_Warn := SPARK_Mode /= On;
+
+ -- Issue error message or warning
+
Error_Msg_N
("RETURN statement missing following this statement<<!",
Last_Stm);
--- /dev/null
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * S I G T R A M P *
+ * *
+ * Asm Implementation File *
+ * *
+ * Copyright (C) 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- *
+ * ware Foundation; either version 3, or (at your option) any later ver- *
+ * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE. *
+ * *
+ * As a special exception under Section 7 of GPL version 3, you are granted *
+ * additional permissions described in the GCC Runtime Library Exception, *
+ * version 3.1, as published by the Free Software Foundation. *
+ * *
+ * In particular, you can freely distribute your programs built with the *
+ * GNAT Pro compiler, including any required library run-time units, using *
+ * any licensing terms of your choosing. See the AdaCore Software License *
+ * for full details. *
+ * *
+ * GNAT was originally developed by the GNAT team at New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc. *
+ * *
+ ****************************************************************************/
+
+/******************************************************
+ * ARM-VxWorks version of the __gnat_sigtramp service *
+ ******************************************************/
+
+#include "sigtramp.h"
+
+#include <vxWorks.h>
+#include <arch/../regs.h>
+#include <sigLib.h>
+
+/* ----------------------
+ -- General comments --
+ ----------------------
+
+ Stubs are generated from toplevel asms and .cfi directives, much simpler
+ to use and check for correctness than manual encodings of CFI byte
+ sequences. The general idea is to establish CFA as sigcontext->sc_pregs
+ and state where to find the registers as offsets from there.
+
+ As of today, we support a single stub, providing CFI info for common
+ registers (GPRs, LR, ...). We might need variants with support for floating
+ point or altivec registers as well at some point.
+
+ Checking which variant should apply and getting at sc_pregs is simpler
+ to express in C (we can't use offsetof in toplevel asms and hardcoding
+ constants is not workable with the flurry of VxWorks variants), so this
+ is the choice for our toplevel interface.
+
+ Note that the registers we "restore" here are those to which we have
+ direct access through the system sigcontext structure, which includes
+ only a partial set of the non-volatiles ABI-wise. */
+
+/* -----------------------------------------
+ -- Protypes for our internal asm stubs --
+ -----------------------------------------
+
+ SC_PREGS is always expected to be SIGCONTEXT->sc_pregs. Eventhough our
+ symbols will remain local, the prototype claims "extern" and not
+ "static" to prevent compiler complaints about a symbol used but never
+ defined. */
+
+/* sigtramp stub providing CFI info for common registers. */
+
+extern void __gnat_sigtramp_common
+(int signo, void *siginfo, void *sigcontext,
+ sighandler_t * handler, void * sc_pregs);
+
+
+/* -------------------------------------
+ -- Common interface implementation --
+ -------------------------------------
+
+ We enforce optimization to minimize the overhead of the extra layer. */
+
+void __gnat_sigtramp (int signo, void *si, void *sc,
+ sighandler_t * handler)
+ __attribute__((optimize(2)));
+
+void __gnat_sigtramp (int signo, void *si, void *sc,
+ sighandler_t * handler)
+{
+ struct sigcontext * sctx = (struct sigcontext *) sc;
+
+ __gnat_sigtramp_common (signo, si, sctx, handler, sctx->sc_pregs);
+}
+
+
+/* ---------------------------
+ -- And now the asm stubs --
+ ---------------------------
+
+ They all have a common structure with blocks of asm sequences queued one
+ after the others. Typically:
+
+ SYMBOL_START
+
+ CFI_DIRECTIVES
+ CFI_DEF_CFA,
+ CFI_COMMON_REGISTERS,
+ ...
+
+ STUB_BODY
+ asm code to establish frame, setup the cfa reg value,
+ call the real signal handler, ...
+
+ SYMBOL_END
+*/
+
+/*--------------------------------
+ -- Misc constants and helpers --
+ -------------------------------- */
+
+/* REGNO constants, dwarf column numbers for registers of interest. */
+
+#define REGNO_G_REG_OFFSET(N) (N)
+
+#define REGNO_PC_OFFSET 15 /* ARG_POINTER_REGNUM */
+
+/* asm string construction helpers. */
+
+#define STR(TEXT) #TEXT
+/* stringify expanded TEXT, surrounding it with double quotes. */
+
+#define S(E) STR(E)
+/* stringify E, which will resolve as text but may contain macros
+ still to be expanded. */
+
+/* asm (TEXT) outputs <tab>TEXT. These facilitate the output of
+ multine contents: */
+#define TAB(S) "\t" S
+#define CR(S) S "\n"
+
+#undef TCR
+#define TCR(S) TAB(CR(S))
+
+/*------------------------------
+ -- Stub construction blocks --
+ ------------------------------ */
+
+/* CFA setup block
+ ---------------
+ 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. */
+
+#define CFA_REG 8
+
+#define CFI_DEF_CFA \
+CR(".cfi_def_cfa " S(CFA_REG) ", 0")
+
+/* Register location blocks
+ ------------------------
+ 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. */
+
+#define COMMON_CFI(REG) \
+ ".cfi_offset " S(REGNO_##REG) "," S(REG_SET_##REG)
+
+#define CFI_COMMON_REGS \
+CR("# CFI for common registers\n") \
+TCR(COMMON_CFI(G_REG_OFFSET(1))) \
+TCR(COMMON_CFI(G_REG_OFFSET(2))) \
+TCR(COMMON_CFI(G_REG_OFFSET(3))) \
+TCR(COMMON_CFI(G_REG_OFFSET(4))) \
+TCR(COMMON_CFI(G_REG_OFFSET(5))) \
+TCR(COMMON_CFI(G_REG_OFFSET(6))) \
+TCR(COMMON_CFI(G_REG_OFFSET(7))) \
+TCR(COMMON_CFI(G_REG_OFFSET(8))) \
+TCR(COMMON_CFI(G_REG_OFFSET(9))) \
+TCR(COMMON_CFI(G_REG_OFFSET(10))) \
+TCR(COMMON_CFI(G_REG_OFFSET(11))) \
+TCR(COMMON_CFI(G_REG_OFFSET(12))) \
+TCR(COMMON_CFI(G_REG_OFFSET(13))) \
+TCR(COMMON_CFI(G_REG_OFFSET(14))) \
+TCR(COMMON_CFI(PC_OFFSET)) \
+TCR(".cfi_return_column " S(REGNO_PC_OFFSET))
+
+/* Trampoline body block
+ --------------------- */
+
+#define SIGTRAMP_BODY \
+CR("") \
+TCR("# Allocate frame and save the non-volatile") \
+TCR("# registers we're going to modify") \
+TCR("mov ip, sp") \
+TCR("stmfd sp!, {r"S(CFA_REG)", fp, ip, lr, pc}") \
+TCR("# Setup CFA_REG = sc_pregs, that we'll retrieve as our CFA value") \
+TCR("ldr r"S(CFA_REG)", [ip]") \
+TCR("") \
+TCR("# Call the real handler. The signo, siginfo and sigcontext") \
+TCR("# arguments are the same as those we received in r0, r1 and r2") \
+TCR("sub fp, ip, #4") \
+TCR("blx r3") \
+TCR("# Restore our callee-saved items, release our frame and return") \
+TCR("ldmfd sp, {r"S(CFA_REG)", fp, sp, pc}")
+
+
+/* Symbol definition block
+ ----------------------- */
+
+#define SIGTRAMP_START(SYM) \
+CR("# " S(SYM) " cfi trampoline") \
+TCR(".type " S(SYM) ", %function") \
+CR("") \
+CR(S(SYM) ":") \
+TCR(".cfi_startproc") \
+TCR(".cfi_signal_frame")
+
+/* Symbol termination block
+ ------------------------ */
+
+#define SIGTRAMP_END(SYM) \
+CR(".cfi_endproc") \
+TCR(".size " S(SYM) ", .-" S(SYM))
+
+/*----------------------------
+ -- And now, the real code --
+ ---------------------------- */
+
+/* Text section start. The compiler isn't aware of that switch. */
+
+asm (".text\n"
+ TCR(".align 2"));
+
+/* sigtramp stub for common registers. */
+
+#define TRAMP_COMMON __gnat_sigtramp_common
+
+asm (SIGTRAMP_START(TRAMP_COMMON));
+asm (CFI_DEF_CFA);
+asm (CFI_COMMON_REGS);
+asm (SIGTRAMP_BODY);
+asm (SIGTRAMP_END(TRAMP_COMMON));
+
+
Name_Const : constant Name_Id := N + $;
Name_Error : constant Name_Id := N + $;
+ Name_False : constant Name_Id := N + $;
Name_Go : constant Name_Id := N + $;
Name_Put : constant Name_Id := N + $;
Name_Put_Line : constant Name_Id := N + $;