diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f1ef4abd5e8..882fb8c5059 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2015-10-23 Hristian Kirtchev + + * sem_util.adb (Denotes_Iterator): New routine. + (Is_Iterator): Code cleanup. Factor out the detection of a + predefined iterator. As a result this fixes a missing case + where a tagged type implements interface Reversible_Iterator. + +2015-10-23 Ed Schonberg + + * sem_attr.adb (Eval_Attribute): Constant-fold 'Enabled if + not within a generic unit, even if expander is not active, so + that instances of container packages remain preelaborable in + -gnatc mode. + +2015-10-23 Tristan Gingold + + * init.c (__gnat_sigtramp): New assembly function for arm64-darwin. + (__gnat_error_handler): Use trampoline for arm64. + +2015-10-23 Ed Schonberg + + * exp_ch3.adb (Expand_N_Object_Declaration): if the type of the + object is a class-wide limited interface type, the expression + is not restricted to the forms specified for limited types. + +2015-10-23 Vincent Celier + + * gnatname.adb: Code clean up. + * s-taasde.ads: Fix comment. + 2015-10-23 Ed Schonberg * sem_util.adb (Is_Iterator, Is_Reversible_iterator): Use diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 57104b3d33c..4718ff5f635 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6916,6 +6916,7 @@ package body Exp_Ch3 is elsif Is_Tagged_Type (Typ) and then Is_Class_Wide_Type (Typ) and then Is_Limited_Record (Typ) + and then not Is_Limited_Interface (Typ) then -- Given that the type is limited we cannot perform a copy. If -- Expr_Q is the reference to a variable we mark the variable diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 82f32747948..d95da85ea07 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-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- -- @@ -434,7 +434,7 @@ procedure Gnatname is elsif Arg = "-h" then Usage_Needed := True; - -- -p + -- -P elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then if File_Set then diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 443b3389379..c649d672414 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -2256,6 +2256,47 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */ #include #endif +#ifdef __arm64__ +#include + +/* Trampoline inserted before raising the exception. It modifies the + stack so that PROC (D, M) looks to be called from the fault point. Note + that LR may be incorrectly set. */ +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. */ +" ldp fp, lr, [x2, #248]\n" + /* Read SP and PC from mcontext. */ +" ldp x6, x7, [x2, #264]\n" +" add lr, x7, #1\n" +" mov sp, x6\n" + /* Create a standard frame. */ +" stp fp, lr, [sp, #-16]!\n" +" .cfi_def_cfa w29, 16\n" +" .cfi_offset w30, -8\n" +" .cfi_offset w29, -16\n" +" br x3\n" +" .cfi_endproc\n" +); +#endif + /* Return true if ADDR is within a stack guard area. */ static int __gnat_is_stack_guard (mach_vm_address_t addr) @@ -2363,6 +2404,15 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext) 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__ + /* 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: diff --git a/gcc/ada/s-taasde.ads b/gcc/ada/s-taasde.ads index 46dc17877f3..11227539dd7 100644 --- a/gcc/ada/s-taasde.ads +++ b/gcc/ada/s-taasde.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2015, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -133,7 +133,7 @@ private -- A double linked list end record; - -- The above "overlaying" of Self_ID and Level to hold other data that has + -- The above "overlaying" of Self_Id and Level to hold other data that has -- a non-overlapping lifetime is an unabashed hack to save memory. procedure Time_Enqueue diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4c5add8b69c..948d71af0fa 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7209,10 +7209,11 @@ package body Sem_Attr is -- We skip evaluation if the expander is not active. This is not just -- an optimization. It is of key importance that we not rewrite the -- attribute in a generic template, since we want to pick up the - -- setting of the check in the instance, and testing expander active - -- is as easy way of doing this as any. + -- setting of the check in the instance, Testing Expander_Active + -- might seem an easy way of doing this, but we need to account for + -- ASIS needs, so check explicitly for a generic context. - if Expander_Active then + if not Inside_A_Generic then declare C : constant Check_Id := Get_Check_Id (Chars (P)); R : Boolean; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 325e3c58499..a8052000b31 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12114,21 +12114,37 @@ package body Sem_Util is ----------------- function Is_Iterator (Typ : Entity_Id) return Boolean is - Ifaces_List : Elist_Id; - Iface_Elmt : Elmt_Id; - Iface : Entity_Id; + function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean; + -- Determine whether type Iter_Typ is a predefined forward or reversible + -- iterator. + + ---------------------- + -- Denotes_Iterator -- + ---------------------- + + function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean is + begin + return + Nam_In (Chars (Iter_Typ), Name_Forward_Iterator, + Name_Reversible_Iterator) + and then Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Iter_Typ))); + end Denotes_Iterator; + + -- Local variables + + Iface_Elmt : Elmt_Id; + Ifaces : Elist_Id; + + -- Start of processing for Is_Iterator begin -- The type may be a subtype of a descendant of the proper instance of -- the predefined interface type, so we must use the root type of the - -- given type. The same us done for Is_Reversible_Iterator. + -- given type. The same is done for Is_Reversible_Iterator. if Is_Class_Wide_Type (Typ) - and then Nam_In (Chars (Root_Type (Typ)), Name_Forward_Iterator, - Name_Reversible_Iterator) - and then - Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Root_Type (Typ)))) + and then Denotes_Iterator (Root_Type (Typ)) then return True; @@ -12139,16 +12155,11 @@ package body Sem_Util is return True; else - Collect_Interfaces (Typ, Ifaces_List); + Collect_Interfaces (Typ, Ifaces); - Iface_Elmt := First_Elmt (Ifaces_List); + Iface_Elmt := First_Elmt (Ifaces); while Present (Iface_Elmt) loop - Iface := Node (Iface_Elmt); - if Chars (Iface) = Name_Forward_Iterator - and then - Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Iface))) - then + if Denotes_Iterator (Node (Iface_Elmt)) then return True; end if;