Skip to content

R
riscv-gcc-1
Commit b8c9f7af by Arnaud Charlet
Options

[multiple changes] 

2015-11-13  Eric Botcazou  <ebotcazou@adacore.com>

	* init.c [Darwin/arm64]: Move __gnat_sigtramp implementation to...
	(__gnat_map_signal): New function.
	(__gnat_error_handler):
	Adjust the context and call above function.
	* sigtramp-armios.c: ...here.  New file.

2015-11-13  Arnaud Charlet  <charlet@adacore.com>

	* bcheck.adb (Check_Consistent_Restrictions): Do not check
	consistency of No_Dependence for runtime units.

2015-11-13  Tristan Gingold  <gingold@adacore.com>

	* s-rident.ads (Restriction_Id): Add Pure_Barriers.
	* restrict.ads (Implementation_Restriction): Add Pure_Barriers.
	* exp_ch9.adb (Expand_Entry_Barrier): Create
	Is_Simple_Barrier_Name function, add Is_Pure_Barrier and
	Check_Pure_Barriers.

2015-11-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Get_Cursor_Type): To determine whether a function
	First is the proper Iterable primitive, use the base type of the
	first formal rather than the type. This is needed in the unusual
	case where the Iterable aspect is specified for an integer type.

From-SVN: r230305
parent 4e9ee595
Showing with 256 additions and 81 deletions
gcc/ada/ChangeLog
2015-11-13 Eric Botcazou <ebotcazou@adacore.com>
* init.c [Darwin/arm64]: Move __gnat_sigtramp implementation to...
(__gnat_map_signal): New function.
(__gnat_error_handler):
Adjust the context and call above function.
* sigtramp-armios.c: ...here. New file.
2015-11-13 Arnaud Charlet <charlet@adacore.com>
* bcheck.adb (Check_Consistent_Restrictions): Do not check
consistency of No_Dependence for runtime units.
2015-11-13 Tristan Gingold <gingold@adacore.com>
* s-rident.ads (Restriction_Id): Add Pure_Barriers.
* restrict.ads (Implementation_Restriction): Add Pure_Barriers.
* exp_ch9.adb (Expand_Entry_Barrier): Create
Is_Simple_Barrier_Name function, add Is_Pure_Barrier and
Check_Pure_Barriers.
2015-11-13 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Get_Cursor_Type): To determine whether a function
First is the proper Iterable primitive, use the base type of the
first formal rather than the type. This is needed in the unusual
case where the Iterable aspect is specified for an integer type.
2015-11-13 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Constant_Indexing_OK): If the indexing is the
......
gcc/ada/bcheck.adb
......@@ -979,15 +979,18 @@ package body Bcheck is
for J in ALIs.First .. ALIs.Last loop
declare
A : ALIs_Record renames ALIs.Table (J);
begin
for K in A.First_Unit .. A.Last_Unit loop
declare
U : Unit_Record renames Units.Table (K);
begin
-- Exclude runtime units from this check since the
-- user does not care how a runtime unit is
-- implemented.
if not Is_Internal_File_Name (U.Sfile) then
for L in U.First_With .. U.Last_With loop
if Same_Unit
(Withs.Table (L).Uname, ND_Unit)
if Same_Unit (Withs.Table (L).Uname, ND_Unit)
then
Error_Msg_File_1 := U.Sfile;
Error_Msg_Name_1 := ND_Unit;
......@@ -996,6 +999,7 @@ package body Bcheck is
"No_Dependence => %");
end if;
end loop;
end if;
end;
end loop;
end;
......
gcc/ada/exp_ch9.adb
......@@ -6306,6 +6306,14 @@ package body Exp_Ch9 is
-- Check whether entity in Barrier is external to protected type.
-- If so, barrier may not be properly synchronized.
function Is_Pure_Barrier (N : Node_Id) return Traverse_Result;
-- Check whether N follow the Pure_Barriers restriction. Return OK if
-- so.
function Is_Simple_Barrier_Name (N : Node_Id) return Boolean;
-- Check wether entity name N denotes a component of the protected
-- object. This is used to check the Simple_Barrier restriction.
----------------------
-- Is_Global_Entity --
----------------------
......@@ -6356,6 +6364,81 @@ package body Exp_Ch9 is
procedure Check_Unprotected_Barrier is
new Traverse_Proc (Is_Global_Entity);
----------------------------
-- Is_Simple_Barrier_Name --
----------------------------
function Is_Simple_Barrier_Name (N : Node_Id) return Boolean is
Renamed : Node_Id;
begin
if not Expander_Active then
return Scope (Entity (N)) = Current_Scope;
-- Check for case of _object.all.field (note that the explicit
-- dereference gets inserted by analyze/expand of _object.field)
else
Renamed := Renamed_Object (Entity (N));
return Present (Renamed)
and then Nkind (Renamed) = N_Selected_Component
and then Chars (Prefix (Prefix (Renamed))) = Name_uObject;
end if;
end Is_Simple_Barrier_Name;
---------------------
-- Is_Pure_Barrier --
---------------------
function Is_Pure_Barrier (N : Node_Id) return Traverse_Result is
begin
case Nkind (N) is
when N_Identifier
| N_Expanded_Name =>
if No (Entity (N)) then
return Abandon;
end if;
case Ekind (Entity (N)) is
when E_Constant
| E_Discriminant
| E_Named_Integer
| E_Named_Real
| E_Enumeration_Literal =>
return OK;
when E_Variable =>
if Is_Simple_Barrier_Name (N) then
return OK;
end if;
when others =>
null;
end case;
when N_Integer_Literal
| N_Real_Literal
| N_Character_Literal =>
return OK;
when N_Op_Boolean
| N_Op_Not =>
if Ekind (Entity (N)) = E_Operator then
return OK;
end if;
when N_Short_Circuit =>
return OK;
when others =>
null;
end case;
return Abandon;
end Is_Pure_Barrier;
function Check_Pure_Barriers is new Traverse_Func (Is_Pure_Barrier);
-- Start of processing for Expand_Entry_Barrier
begin
......@@ -6393,6 +6476,12 @@ package body Exp_Ch9 is
Analyze_And_Resolve (Cond, Any_Boolean);
end if;
-- Check Pure_Barriers restriction
if Check_Pure_Barriers (Cond) = Abandon then
Check_Restriction (Pure_Barriers, Cond);
end if;
-- The Ravenscar profile restricts barriers to simple variables declared
-- within the protected object. We also allow Boolean constants, since
-- these appear in several published examples and are also allowed by
......@@ -6421,22 +6510,7 @@ package body Exp_Ch9 is
then
return;
elsif not Expander_Active
and then Scope (Entity (Cond)) = Current_Scope
then
return;
-- Check for case of _object.all.field (note that the explicit
-- dereference gets inserted by analyze/expand of _object.field)
elsif Present (Renamed_Object (Entity (Cond)))
and then
Nkind (Renamed_Object (Entity (Cond))) = N_Selected_Component
and then
Chars
(Prefix
(Prefix (Renamed_Object (Entity (Cond))))) = Name_uObject
then
elsif Is_Simple_Barrier_Name (Cond) then
return;
end if;
end if;
......
gcc/ada/init.c
......@@ -2299,45 +2299,7 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
#ifdef __arm64__
#include <sys/ucontext.h>
/* Trampoline inserted before raising the exception. It modifies the
stack so that it looks to be called directly from the fault point.
Note that LR may be incorrectly restored by unwinding. */
void __gnat_sigtramp (struct Exception_Data *d, const char *m,
mcontext_t ctxt,
void (*proc)(struct Exception_Data *, const char *));
asm("\n"
" .section __TEXT,__text,regular,pure_instructions\n"
" .align 2\n"
"___gnat_sigtramp:\n"
" .cfi_startproc\n"
/* Restore callee saved registers. */
" ldp x19, x20, [x2, #168]\n"
" ldp x21, x22, [x2, #184]\n"
" ldp x23, x24, [x2, #200]\n"
" ldp x25, x26, [x2, #216]\n"
" ldp x27, x28, [x2, #232]\n"
" ldp q8, q9, [x2, #416]\n"
" ldp q10, q11, [x2, #448]\n"
" ldp q12, q13, [x2, #480]\n"
" ldp q14, q15, [x2, #512]\n"
/* Read FP from mcontext. */
" ldr fp, [x2, #248]\n"
/* Read SP and PC from mcontext. */
" ldp x6, lr, [x2, #264]\n"
" mov sp, x6\n"
/* Create a minimal frame. */
" stp fp, lr, [sp, #-16]!\n"
" .cfi_def_cfa_offset 16\n"
" .cfi_offset 30, -8\n"
" .cfi_offset 29, -16\n"
" blr x3\n"
/* Release our frame and return (should never get here!). */
" ldp fp, lr, [sp, #16]\n"
" ret\n"
" .cfi_endproc\n"
);
#include "sigtramp.h"
#endif
/* Return true if ADDR is within a stack guard area. */
......@@ -2425,13 +2387,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
}
static void
__gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
__gnat_map_signal (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
{
struct Exception_Data *exception;
const char *msg;
__gnat_adjust_context_for_raise (sig, ucontext);
switch (sig)
{
case SIGSEGV:
......@@ -2446,29 +2406,11 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
exception = &constraint_error;
msg = "erroneous memory access";
}
/* Reset the use of alt stack, so that the alt stack will be used
for the next signal delivery.
The stack can't be used in case of stack checking. */
syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
#ifdef __arm64__
/* ??? Temporary kludge to make stack checking work. The problem is
that the trampoline doesn't restore LR and, consequently, doesn't
make it possible to unwind past an interrupted frame which hasn"t
saved LR on the stack yet. */
if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
{
ucontext_t *uc = (ucontext_t *)ucontext;
uc->uc_mcontext->__ss.__pc = uc->uc_mcontext->__ss.__lr;
}
/* On arm64, use a trampoline so that the unwinder won't see the
signal frame. */
__gnat_sigtramp (exception, msg,
((ucontext_t *)ucontext)->uc_mcontext,
Raise_From_Signal_Handler);
return;
#endif
break;
case SIGFPE:
......@@ -2484,6 +2426,30 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
Raise_From_Signal_Handler (exception, msg);
}
static void
__gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
{
__gnat_adjust_context_for_raise (sig, ucontext);
#ifdef __arm64__
/* ??? Temporary kludge to make stack checking work. The problem is
that the trampoline doesn't restore LR and, consequently, doesn't
make it possible to unwind past an interrupted frame which hasn"t
saved LR on the stack yet. */
if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
{
ucontext_t *uc = (ucontext_t *)ucontext;
uc->uc_mcontext->__ss.__pc = uc->uc_mcontext->__ss.__lr;
}
/* Use a trampoline so that the unwinder won't see the signal frame. */
__gnat_sigtramp (sig, (void *)si, ucontext,
(__sigtramphandler_t *)&__gnat_map_signal);
#else
__gnat_map_signal (sig, si, ucontext);
#endif
}
void
__gnat_install_handler (void)
{
......
gcc/ada/restrict.ads
......@@ -147,6 +147,7 @@ package Restrict is
No_Wide_Characters => True,
Static_Priorities => True,
Static_Storage_Size => True,
Pure_Barriers => True,
SPARK_05 => True,
others => False);
......
gcc/ada/s-rident.ads
......@@ -182,6 +182,7 @@ package System.Rident is
No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368
No_Wide_Characters, -- GNAT
Pure_Barriers, -- GNAT
SPARK_05, -- GNAT
-- The following cases require a parameter value
......
gcc/ada/sem_util.adb
......@@ -7553,13 +7553,16 @@ package body Sem_Util is
Cursor := Any_Type;
-- Locate function with desired name and profile in scope of type
-- In the rare case where the type is an integer type, a base type
-- is created for it, check that the base type of the first formal
-- of First matches the base type of the domain.
Func := First_Entity (Scope (Typ));
while Present (Func) loop
if Chars (Func) = Chars (First_Op)
and then Ekind (Func) = E_Function
and then Present (First_Formal (Func))
and then Etype (First_Formal (Func)) = Typ
and then Base_Type (Etype (First_Formal (Func))) = Base_Type (Typ)
and then No (Next_Formal (First_Formal (Func)))
then
if Cursor /= Any_Type then
......
gcc/ada/sigtramp-armios.c 0 → 100644
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* S I G T R A M P *
* *
* Asm Implementation File *
* *
* Copyright (C) 2015, 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-IOS version of the __gnat_sigtramp service *
**************************************************/
#include <sys/ucontext.h>
#include "sigtramp.h"
/* See sigtramp.h for a general explanation of functionality. */
/* -----------------------------------------
-- Protypes for our internal asm stubs --
-----------------------------------------
The registers are expected to be at SIGCONTEXT + OFFSET (reference to the
machine context structure). Even though 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 unwind info for common registers. */
extern void __gnat_sigtramp_common
(int signo, void *siginfo, void *sigcontext,
__sigtramphandler_t * handler);
void __gnat_sigtramp (int signo, void *si, void *ucontext,
__sigtramphandler_t * handler)
__attribute__((optimize(2)));
void __gnat_sigtramp (int signo, void *si, void *ucontext,
__sigtramphandler_t * handler)
{
mcontext_t mcontext = ((ucontext_t *) ucontext)->uc_mcontext;
__gnat_sigtramp_common (signo, si, mcontext, handler);
}
asm("\n"
" .section __TEXT,__text,regular,pure_instructions\n"
" .align 2\n"
"___gnat_sigtramp_common:\n"
" .cfi_startproc\n"
/* Restore callee saved registers. */
" ldp x19, x20, [x2, #168]\n"
" ldp x21, x22, [x2, #184]\n"
" ldp x23, x24, [x2, #200]\n"
" ldp x25, x26, [x2, #216]\n"
" ldp x27, x28, [x2, #232]\n"
" ldp q8, q9, [x2, #416]\n"
" ldp q10, q11, [x2, #448]\n"
" ldp q12, q13, [x2, #480]\n"
" ldp q14, q15, [x2, #512]\n"
/* Read FP from mcontext. */
" ldr fp, [x2, #248]\n"
/* Read SP and PC from mcontext. */
" ldp x6, lr, [x2, #264]\n"
" mov sp, x6\n"
/* Create a minimal frame. */
" stp fp, lr, [sp, #-16]!\n"
" .cfi_def_cfa_offset 16\n"
" .cfi_offset 30, -8\n"
" .cfi_offset 29, -16\n"
" blr x3\n"
/* Release our frame and return (should never get here!). */
" ldp fp, lr, [sp, #16]\n"
" ret\n"
" .cfi_endproc\n"
);
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment