-- --
------------------------------------------------------------------------------
-with Interfaces.C_Streams; use Interfaces.C_Streams;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.Communication; use System.Communication;
-- Create protected operation as well. Even though the operation
-- is only accessible within the body, it is possible to make it
-- available outside of the protected object by using 'Access to
- -- provide a callback, so we build the protected version in all
- -- cases.
+ -- provide a callback, so build protected version in all cases.
Prot_Decl :=
- Make_Subprogram_Declaration (Loc,
- Specification =>
- Build_Protected_Sub_Specification
- (N, Scop, Protected_Mode));
+ Make_Subprogram_Declaration (Loc,
+ Specification =>
+ Build_Protected_Sub_Specification (N, Scop, Protected_Mode));
Insert_Before (Prot_Bod, Prot_Decl);
Analyze (Prot_Decl);
else
New_Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Make_Defining_Identifier (Sloc (Body_Id),
- Chars => Chars (Body_Id)),
- Parameter_Specifications =>
- Plist,
- Result_Definition =>
- New_Occurrence_Of (Etype (Body_Id), Loc));
+ Defining_Unit_Name =>
+ Make_Defining_Identifier (Sloc (Body_Id),
+ Chars => Chars (Body_Id)),
+ Parameter_Specifications => Plist,
+ Result_Definition =>
+ New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
-- The internal processing state of the hashing function
function "=" (L, R : Context) return Boolean is abstract;
- -- Context is the internal, implementation defined state of an
- -- intermediate state in a hash computation, and no specific semantics
- -- can be expected on equality of context values. Only equality of
- -- final hash values (as returned by the [Wide_]Digest functions below)
- -- is meaningful.
+ -- Context is the internal, implementation defined intermediate state
+ -- in a hash computation, and no specific semantics can be expected on
+ -- equality of context values. Only equality of final hash values (as
+ -- returned by the [Wide_]Digest functions below) is meaningful.
Initial_Context : constant Context;
-- Initial value of a Context object. May be used to reinitialize
Last : out Ada.Streams.Stream_Element_Offset);
-- Read a set of bytes, put result into Buffer and set Last accordingly.
-- Last is set to Buffer'First - 1 if no byte has been read, unless
- -- Buffer'First = Stream_Element_Offset'First, in which case
- -- Constraint_Error raised instead.
+ -- Buffer'First = Stream_Element_Offset'First, in which case the exception
+ -- Constraint_Error is raised instead.
overriding procedure Write
(Port : in out Serial_Port;
Add_Char_To_Name_Buffer ('"');
Add_Str_To_Name_Buffer
(Get_Name_String
- (Unit.File_Names (Kind).Path.Display_Name));
+ (Unit.File_Names (Kind).Path.Display_Name));
Add_Char_To_Name_Buffer ('"');
if FD /= Invalid_FD then
Last := Nlast;
end if;
- -- Given a Gnat standard library, search the
- -- library path to find the library location
+ -- Given a Gnat standard library, search the library path to
+ -- find the library location.
+
+ -- Shouldn't we abstract a proc here, we are getting awfully
+ -- heavily nested ???
declare
File_Path : String_Access;
elsif GNAT_Shared then
if Opt.Run_Path_Option then
+
-- If shared gnatlib desired, add the
-- appropriate system specific switch
-- so that it can be located at runtime.
if Run_Path_Opt'Length /= 0 then
+
-- Output the system specific linker command
-- that allows the image activator to find
- -- the shared library at runtime.
- -- Also add path to find libgcc_s.so, if
- -- relevant.
+ -- the shared library at runtime. Also add
+ -- path to find libgcc_s.so, if relevant.
declare
Path : String (1 .. File_Path'Length + 15);
Index (Path (1 .. Path_Last), "gcc-lib");
if GCC_Index /= 0 then
+
-- The shared version of libgcc is
-- located in the parent directory.
Linker_Options.Increment_Last;
Linker_Options.Table
(Linker_Options.Last) :=
- new String'
- (Run_Path_Opt
- & File_Path
- (1 .. File_Path'Length
- - File_Name'Length));
+ new String'
+ (Run_Path_Opt
+ & File_Path
+ (1 .. File_Path'Length
+ - File_Name'Length));
if GCC_Index /= 0 then
Linker_Options.Increment_Last;
(Run_Path_Opt
& Path (1 .. GCC_Index));
end if;
+
else
for J in reverse
1 .. Linker_Options.Last
if Linker_Options.Table (J) /= null
and then
Linker_Options.Table (J)'Length
- > Run_Path_Opt'Length
+ > Run_Path_Opt'Length
and then
Linker_Options.Table (J)
- (1 .. Run_Path_Opt'Length) =
- Run_Path_Opt
+ (1 .. Run_Path_Opt'Length) =
+ Run_Path_Opt
then
- -- We have found a already
+ -- We have found an already
-- specified run_path_option: we
-- will add to this switch,
-- because only one
if Run_Path_Opt_Index = 0 then
Linker_Options.Table
(Linker_Options.Last) :=
- new String'
- (Run_Path_Opt
- & File_Path
- (1 .. File_Path'Length
- - File_Name'Length));
+ new String'
+ (Run_Path_Opt
+ & File_Path
+ (1 .. File_Path'Length
+ - File_Name'Length));
else
Linker_Options.Table
(Run_Path_Opt_Index) :=
- new String'
- (Linker_Options.Table
- (Run_Path_Opt_Index).all
- & Path_Separator
- & File_Path
- (1 .. File_Path'Length
- - File_Name'Length));
+ new String'
+ (Linker_Options.Table
+ (Run_Path_Opt_Index).all
+ & Path_Separator
+ & File_Path
+ (1 .. File_Path'Length
+ - File_Name'Length));
end if;
else
if Run_Path_Opt_Index = 0 then
Linker_Options.Table
(Linker_Options.Last) :=
- new String'(Run_Path_Opt
- & File_Path
- (1 .. File_Path'Length
- - File_Name'Length)
- & Path_Separator
- & Path (1 .. GCC_Index));
+ new String'
+ (Run_Path_Opt
+ & File_Path
+ (1 .. File_Path'Length
+ - File_Name'Length)
+ & Path_Separator
+ & Path (1 .. GCC_Index));
else
Linker_Options.Table
(Run_Path_Opt_Index) :=
- new String'
- (Linker_Options.Table
- (Run_Path_Opt_Index).all
- & Path_Separator
- & File_Path
- (1 .. File_Path'Length
- - File_Name'Length)
- & Path_Separator
- & Path (1 .. GCC_Index));
+ new String'
+ (Linker_Options.Table
+ (Run_Path_Opt_Index).all
+ & Path_Separator
+ & File_Path
+ (1 .. File_Path'Length
+ - File_Name'Length)
+ & Path_Separator
+ & Path (1 .. GCC_Index));
end if;
end if;
end if;
-- Start of processing for Gnatlink
begin
- -- Add the directory where gnatlink is invoked in front of the
- -- path, if gnatlink is invoked with directory information.
- -- Only do this if the platform is not VMS, where the notion of path
- -- does not really exist.
+ -- Add the directory where gnatlink is invoked in front of the path, if
+ -- gnatlink is invoked with directory information. Only do this if the
+ -- platform is not VMS, where the notion of path does not really exist.
if not Hostparm.OpenVMS then
declare
Normalize_Pathname
(Command (Command'First .. Index));
- PATH : constant String :=
- Absolute_Dir &
- Path_Separator &
- Getenv ("PATH").all;
+ PATH : constant String :=
+ Absolute_Dir &
+ Path_Separator &
+ Getenv ("PATH").all;
begin
Setenv ("PATH", PATH);
Process_Args;
if Argument_Count = 0
- or else
- (Verbose_Mode and then Argument_Count = 1)
+ or else (Verbose_Mode and then Argument_Count = 1)
then
Write_Usage;
Exit_Program (E_Fatal);
Exit_With_Error (Ali_File_Name.all & " not found");
end if;
- -- Read the ALI file of the main subprogram if the binder generated
- -- file needs to be compiled and no --GCC= switch has been specified.
- -- Fetch the back end switches from this ALI file and use these switches
- -- to compile the binder generated file
+ -- Read the ALI file of the main subprogram if the binder generated file
+ -- needs to be compiled and no --GCC= switch has been specified. Fetch the
+ -- back end switches from this ALI file and use these switches to compile
+ -- the binder generated file
if Compile_Bind_File and then Standard_Gcc then
:= String_Access (Arg);
end if;
- -- Set the RTS_*_Path_Name variables, so that the
- -- correct directories will be set when
+ -- Set the RTS_*_Path_Name variables, so that
+ -- the correct directories will be set when
-- Osint.Add_Default_Search_Dirs will be called later.
Opt.RTS_Src_Path_Name :=
}
static void
-__gnat_error_handler
- (int sig, siginfo_t *sip, struct sigcontext *context)
+__gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
{
struct Exception_Data *exception;
static int recurse = 0;
{
mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
- /* On the i386 and x86-64 architectures, stack checking is performed by
+ /* On the i386 and x86-64 architectures, we specifically detect calls to
+ the null address and entirely fold the not-yet-fully-established frame
+ to prevent it from stopping the unwinding.
+
+ On the i386 and x86-64 architectures, stack checking is performed by
means of probes with moving stack pointer, that is to say the probed
address is always the value of the stack pointer. Upon hitting the
guard page, the stack pointer therefore points to an inaccessible
#if defined (i386)
unsigned long *pc = (unsigned long *)mcontext->gregs[REG_EIP];
+ /* The call insn pushes the return address onto the stack. Pop it. */
+ if (pc == NULL)
+ {
+ mcontext->gregs[REG_EIP] = *(unsigned long *)mcontext->gregs[REG_ESP];
+ mcontext->gregs[REG_ESP] += 4;
+ }
/* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */
- if (signo == SIGSEGV && pc && *pc == 0x00240c83)
+ else if (signo == SIGSEGV && *pc == 0x00240c83)
mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long);
#elif defined (__x86_64__)
unsigned long *pc = (unsigned long *)mcontext->gregs[REG_RIP];
+ /* The call insn pushes the return address onto the stack. Pop it. */
+ if (pc == NULL)
+ {
+ mcontext->gregs[REG_RIP] = *(unsigned long *)mcontext->gregs[REG_RSP];
+ mcontext->gregs[REG_RSP] += 8;
+ }
/* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */
- if (signo == SIGSEGV && pc && (*pc & 0xffffffffff) == 0x00240c8348)
+ else if (signo == SIGSEGV && (*pc & 0xffffffffff) == 0x00240c8348)
mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long);
#elif defined (__ia64__)
/* ??? The IA-64 unwinder doesn't compensate for signals. */
void *ucontext)
{
struct Exception_Data *exception;
- const char *msg;
static int recurse = 0;
+ const char *msg;
+
+ /* Adjusting is required for every fault context, so adjust for this one
+ now, before we possibly trigger a recursive fault below. */
+ __gnat_adjust_context_for_raise (sig, ucontext);
switch (sig)
{
exception = &program_error;
msg = "unhandled signal";
}
- recurse = 0;
-
- /* We adjust the interrupted context here (and not in the fallback
- unwinding routine) because recent versions of the Native POSIX
- Thread Library (NPTL) are compiled with unwind information, so
- the fallback routine is never executed for signal frames. */
- __gnat_adjust_context_for_raise (sig, ucontext);
+ recurse = 0;
Raise_From_Signal_Handler (exception, msg);
}
/* Likewise regarding how the "instruction pointer" register slot can
be identified in signal machine contexts. We have either "REG_PC"
or "PC" at hand, depending on the target CPU and Solaris version. */
-
#if !defined (REG_PC)
#define REG_PC PC
#endif
-static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
+static void __gnat_error_handler (int, siginfo_t *, void *);
+
+#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+
+void
+__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
+{
+ mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
+ unsigned long *pc = (unsigned long *)mcontext->gregs[REG_PC];
+
+ /* We specifically detect calls to the null address and entirely fold
+ the not-yet-fully-established frame to prevent it from stopping the
+ unwinding. */
+ if (pc == NULL)
+#if defined (__sparc)
+ /* The call insn moves the return address into %o7. Move it back. */
+ mcontext->gregs[REG_PC] = mcontext->gregs[REG_O7];
+#elif defined (i386)
+ {
+ /* The call insn pushes the return address onto the stack. Pop it. */
+ mcontext->gregs[REG_PC] = *(unsigned long *)mcontext->gregs[UESP];
+ mcontext->gregs[UESP] += 4;
+ }
+#elif defined (__x86_64__)
+ {
+ /* The call insn pushes the return address onto the stack. Pop it. */
+ mcontext->gregs[REG_PC] = *(unsigned long *)mcontext->gregs[REG_RSP];
+ mcontext->gregs[REG_RSP] += 8;
+ }
+#else
+#error architecture not supported on Solaris
+#endif
+}
static void
-__gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *cx ATTRIBUTE_UNUSED)
+__gnat_error_handler (int sig, siginfo_t *sip, void *ucontext)
{
struct Exception_Data *exception;
static int recurse = 0;
const char *msg;
- /* If this was an explicit signal from a "kill", just resignal it. */
- if (SI_FROMUSER (sip))
- {
- signal (sig, SIG_DFL);
- kill (getpid(), sig);
- }
+ /* Adjusting is required for every fault context, so adjust for this one
+ now, before we possibly trigger a recursive fault below. */
+ __gnat_adjust_context_for_raise (sig, ucontext);
- /* Otherwise, treat it as something we handle. */
switch (sig)
{
case SIGSEGV:
much too hard to do anything else and we're just determining
which exception to raise. */
if (sip->si_code == SEGV_ACCERR
+ || (long) sip->si_addr == 0
|| (((long) sip->si_addr) & 3) != 0
|| recurse)
{
}
recurse = 0;
-
Raise_From_Signal_Handler (exception, msg);
}
msg = "SIGFPE";
break;
#ifdef VTHREADS
+#ifdef __VXWORKSMILS__
+ case SIGILL:
+ exception = &storage_error;
+ msg = "SIGILL: possible stack overflow";
+ break;
+ case SIGSEGV:
+ exception = &storage_error;
+ msg = "SIGSEGV";
+ break;
+ case SIGBUS:
+ exception = &program_error;
+ msg = "SIGBUS";
+ break;
+#else
case SIGILL:
exception = &constraint_error;
msg = "Floating point exception or SIGILL";
exception = &storage_error;
msg = "SIGBUS: possible stack overflow";
break;
+#endif
#elif (_WRS_VXWORKS_MAJOR == 6)
case SIGILL:
exception = &constraint_error;
"SVdefault_language#" &
"LVrun_path_option#" &
+ "SVrun_path_origin_supported#" &
"SVseparate_run_path_options#" &
"Satoolchain_version#" &
"Satoolchain_description#" &
In_Tree => Data.Tree);
end if;
+ elsif Attribute.Name = Name_Run_Path_Origin_Supported then
+ declare
+ pragma Unsuppress (All_Checks);
+ begin
+ Project.Config.Run_Path_Origin_Supported :=
+ Boolean'Value (Get_Name_String (Attribute.Value.Value));
+ exception
+ when Constraint_Error =>
+ Error_Msg
+ (Data.Flags,
+ "invalid value """ &
+ Get_Name_String (Attribute.Value.Value) &
+ """ for Run_Path_Origin_Supported",
+ Attribute.Value.Location, Project);
+ end;
+
elsif Attribute.Name = Name_Separate_Run_Path_Options then
declare
pragma Unsuppress (All_Checks);
-- The option to use when linking to specify the path where to look for
-- libraries.
+ Run_Path_Origin_Supported : Boolean := False;
+ -- Specify if the run path option support $ORIGIN to indicate paths
+ -- reative to the directory of the executable.
+
Separate_Run_Path_Options : Boolean := False;
-- True if each directory needs to be specified in a separate run path
-- option.
Default_Project_Config : constant Project_Configuration :=
(Target => No_Name,
Run_Path_Option => No_Name_List,
+ Run_Path_Origin_Supported => False,
Separate_Run_Path_Options => False,
Executable_Suffix => No_Name,
Linker => No_Path,
raise Constraint_Error with
"last index out of range (no element transferred)";
else
- return First + SEO (Count - 1);
+ return First + SEO (Count) - 1;
end if;
end Last_Index;
end if;
end if;
+ -- If the aggregate already has bounds attached to it, it means this is
+ -- a positional aggregate created as an optimization by
+ -- Exp_Aggr.Convert_To_Positional, so we don't want to change those
+ -- bounds.
+
+ if Present (Aggregate_Bounds (N)) and then not Others_Allowed then
+ Aggr_Low := Low_Bound (Aggregate_Bounds (N));
+ Aggr_High := High_Bound (Aggregate_Bounds (N));
+ end if;
+
Set_Aggregate_Bounds
(N, Make_Range (Loc, Low_Bound => Aggr_Low, High_Bound => Aggr_High));
Name_Roots : constant Name_Id := N + $; -- GPR
Name_Required_Switches : constant Name_Id := N + $;
Name_Run_Path_Option : constant Name_Id := N + $;
+ Name_Run_Path_Origin_Supported : constant Name_Id := N + $;
Name_Separate_Run_Path_Options : constant Name_Id := N + $;
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + $;
Name_Shared_Library_Prefix : constant Name_Id := N + $;
#ifdef __vxworks
#include "ioLib.h"
+#if ! defined (__VXWORKSMILS__)
#include "dosFsLib.h"
-#if ! defined ( __RTP__) && ! defined (VTHREADS)
+#endif
+#if ! defined (__RTP__) && ! defined (VTHREADS)
# include "nfsLib.h"
#endif
#include "selectLib.h"
/* In the case of VxWorks, we also have to take into account various
* filesystem-specific variants of this error.
*/
+#if ! defined (__VXWORKSMILS__)
case S_dosFsLib_FILE_NOT_FOUND:
+#endif
#if ! defined (__RTP__) && ! defined (VTHREADS)
case S_nfsLib_NFSERR_NOENT:
#endif
projects / platform / upstream / linaro-gcc.git / commitdiff