[multiple changes]
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. From-SVN: r229240
This commit is contained in:
parent
eeedaac578
commit
774454ac02
|
@ -1,3 +1,33 @@
|
||||||
|
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>
|
2015-10-23 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
* sem_util.adb (Is_Iterator, Is_Reversible_iterator): Use
|
* sem_util.adb (Is_Iterator, Is_Reversible_iterator): Use
|
||||||
|
|
|
@ -6916,6 +6916,7 @@ package body Exp_Ch3 is
|
||||||
elsif Is_Tagged_Type (Typ)
|
elsif Is_Tagged_Type (Typ)
|
||||||
and then Is_Class_Wide_Type (Typ)
|
and then Is_Class_Wide_Type (Typ)
|
||||||
and then Is_Limited_Record (Typ)
|
and then Is_Limited_Record (Typ)
|
||||||
|
and then not Is_Limited_Interface (Typ)
|
||||||
then
|
then
|
||||||
-- Given that the type is limited we cannot perform a copy. If
|
-- Given that the type is limited we cannot perform a copy. If
|
||||||
-- Expr_Q is the reference to a variable we mark the variable
|
-- Expr_Q is the reference to a variable we mark the variable
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -434,7 +434,7 @@ procedure Gnatname is
|
||||||
elsif Arg = "-h" then
|
elsif Arg = "-h" then
|
||||||
Usage_Needed := True;
|
Usage_Needed := True;
|
||||||
|
|
||||||
-- -p
|
-- -P
|
||||||
|
|
||||||
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
|
elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
|
||||||
if File_Set then
|
if File_Set then
|
||||||
|
|
|
@ -2256,6 +2256,47 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
|
||||||
#include <mach/vm_statistics.h>
|
#include <mach/vm_statistics.h>
|
||||||
#endif
|
#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. */
|
/* Return true if ADDR is within a stack guard area. */
|
||||||
static int
|
static int
|
||||||
__gnat_is_stack_guard (mach_vm_address_t addr)
|
__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.
|
for the next signal delivery.
|
||||||
The stack can't be used in case of stack checking. */
|
The stack can't be used in case of stack checking. */
|
||||||
syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
|
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;
|
break;
|
||||||
|
|
||||||
case SIGFPE:
|
case SIGFPE:
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -133,7 +133,7 @@ private
|
||||||
-- A double linked list
|
-- A double linked list
|
||||||
end record;
|
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.
|
-- a non-overlapping lifetime is an unabashed hack to save memory.
|
||||||
|
|
||||||
procedure Time_Enqueue
|
procedure Time_Enqueue
|
||||||
|
|
|
@ -7209,10 +7209,11 @@ package body Sem_Attr is
|
||||||
-- We skip evaluation if the expander is not active. This is not just
|
-- 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
|
-- an optimization. It is of key importance that we not rewrite the
|
||||||
-- attribute in a generic template, since we want to pick up the
|
-- attribute in a generic template, since we want to pick up the
|
||||||
-- setting of the check in the instance, and testing expander active
|
-- setting of the check in the instance, Testing Expander_Active
|
||||||
-- is as easy way of doing this as any.
|
-- 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
|
declare
|
||||||
C : constant Check_Id := Get_Check_Id (Chars (P));
|
C : constant Check_Id := Get_Check_Id (Chars (P));
|
||||||
R : Boolean;
|
R : Boolean;
|
||||||
|
|
|
@ -12114,21 +12114,37 @@ package body Sem_Util is
|
||||||
-----------------
|
-----------------
|
||||||
|
|
||||||
function Is_Iterator (Typ : Entity_Id) return Boolean is
|
function Is_Iterator (Typ : Entity_Id) return Boolean is
|
||||||
Ifaces_List : Elist_Id;
|
function Denotes_Iterator (Iter_Typ : Entity_Id) return Boolean;
|
||||||
Iface_Elmt : Elmt_Id;
|
-- Determine whether type Iter_Typ is a predefined forward or reversible
|
||||||
Iface : Entity_Id;
|
-- 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
|
begin
|
||||||
-- The type may be a subtype of a descendant of the proper instance of
|
-- 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
|
-- 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)
|
if Is_Class_Wide_Type (Typ)
|
||||||
and then Nam_In (Chars (Root_Type (Typ)), Name_Forward_Iterator,
|
and then Denotes_Iterator (Root_Type (Typ))
|
||||||
Name_Reversible_Iterator)
|
|
||||||
and then
|
|
||||||
Is_Predefined_File_Name
|
|
||||||
(Unit_File_Name (Get_Source_Unit (Root_Type (Typ))))
|
|
||||||
then
|
then
|
||||||
return True;
|
return True;
|
||||||
|
|
||||||
|
@ -12139,16 +12155,11 @@ package body Sem_Util is
|
||||||
return True;
|
return True;
|
||||||
|
|
||||||
else
|
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
|
while Present (Iface_Elmt) loop
|
||||||
Iface := Node (Iface_Elmt);
|
if Denotes_Iterator (Node (Iface_Elmt)) then
|
||||||
if Chars (Iface) = Name_Forward_Iterator
|
|
||||||
and then
|
|
||||||
Is_Predefined_File_Name
|
|
||||||
(Unit_File_Name (Get_Source_Unit (Iface)))
|
|
||||||
then
|
|
||||||
return True;
|
return True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue