From b8c9f7afb7965379109982bffeaf647b7a8c4a47 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Nov 2015 12:28:27 +0100 Subject: [PATCH] [multiple changes] 2015-11-13 Eric Botcazou * 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 * bcheck.adb (Check_Consistent_Restrictions): Do not check consistency of No_Dependence for runtime units. 2015-11-13 Tristan Gingold * 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 * 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 --- gcc/ada/ChangeLog | 28 ++++++++++ gcc/ada/bcheck.adb | 28 +++++----- gcc/ada/exp_ch9.adb | 106 ++++++++++++++++++++++++++++++++------ gcc/ada/init.c | 88 ++++++++++--------------------- gcc/ada/restrict.ads | 1 + gcc/ada/s-rident.ads | 1 + gcc/ada/sem_util.adb | 5 +- gcc/ada/sigtramp-armios.c | 98 +++++++++++++++++++++++++++++++++++ 8 files changed, 265 insertions(+), 90 deletions(-) create mode 100644 gcc/ada/sigtramp-armios.c diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90910ca0909..324d4dcda5a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2015-11-13 Eric Botcazou + + * 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 + + * bcheck.adb (Check_Consistent_Restrictions): Do not check + consistency of No_Dependence for runtime units. + +2015-11-13 Tristan Gingold + + * 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 + + * 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 * sem_ch4.adb (Constant_Indexing_OK): If the indexing is the diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 2cae8402475..4170b0e8e0e 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -979,23 +979,27 @@ 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 - for L in U.First_With .. U.Last_With loop - if Same_Unit - (Withs.Table (L).Uname, ND_Unit) - then - Error_Msg_File_1 := U.Sfile; - Error_Msg_Name_1 := ND_Unit; - Consistency_Error_Msg - ("file { violates restriction " & - "No_Dependence => %"); - end if; - end loop; + -- 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) + then + Error_Msg_File_1 := U.Sfile; + Error_Msg_Name_1 := ND_Unit; + Consistency_Error_Msg + ("file { violates restriction " & + "No_Dependence => %"); + end if; + end loop; + end if; end; end loop; end; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 2fd65927401..f985019d76f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/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; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index f0afc406454..dcd5c3d0642 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -2299,45 +2299,7 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */ #ifdef __arm64__ #include - -/* 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) { diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 6ce790895d3..c8c050c20a6 100644 --- a/gcc/ada/restrict.ads +++ b/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); diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 58c69d865fc..66aa10e9038 100644 --- a/gcc/ada/s-rident.ads +++ b/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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 59194cf2d26..36dfc4df22f 100644 --- a/gcc/ada/sem_util.adb +++ b/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 diff --git a/gcc/ada/sigtramp-armios.c b/gcc/ada/sigtramp-armios.c new file mode 100644 index 00000000000..3206256ac59 --- /dev/null +++ b/gcc/ada/sigtramp-armios.c @@ -0,0 +1,98 @@ +/**************************************************************************** + * * + * 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 + +#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" +); -- 2.30.2