+2015-10-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <gingold@adacore.com>
+
+ * init.c (__gnat_sigtramp): New assembly function for arm64-darwin.
+ (__gnat_error_handler): Use trampoline for arm64.
+
+2015-10-23 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * gnatname.adb: Code clean up.
+ * s-taasde.ads: Fix comment.
+
2015-10-23 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Iterator, Is_Reversible_iterator): Use
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
-- --
-- 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- --
elsif Arg = "-h" then
Usage_Needed := True;
- -- -p
+ -- -P
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
if File_Set then
#include <mach/vm_statistics.h>
#endif
+#ifdef __arm64__
+#include <sys/ucontext.h>
+
+/* 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)
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:
-- --
-- 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- --
-- 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
-- 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;
-----------------
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;
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;
projects / gcc.git / commitdiff