Skip to content

R
riscv-gcc-1
Commit 774454ac by Arnaud Charlet
Options

[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
parent eeedaac5
Showing with 117 additions and 24 deletions
gcc/ada/ChangeLog
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
......
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
......
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
......
gcc/ada/init.c
......@@ -2256,6 +2256,47 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
#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)
......@@ -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:
......
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
......
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;
......
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;
......
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