[multiple changes]

2015-11-13  Eric Botcazou  <ebotcazou@adacore.com>

	* init.c [Darwin/arm64] (__gnat_sigtramp): Do not increment PC,
	fix CFI and add return sequence.

2015-11-13  Ed Schonberg  <schonberg@adacore.com>

	* exp_fixd.adb (Expand_Convert_Float_To_Fixed): If the conversion
	comes from an attribute reference 'Round, the operation must
	round and not truncate.
	* sem_res.adb, sem_ch6.adb: Minor editing.

From-SVN: r230302

gcc/ada/ChangeLog

+2015-11-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* init.c [Darwin/arm64] (__gnat_sigtramp): Do not increment PC,
+	fix CFI and add return sequence.
+
+2015-11-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_fixd.adb (Expand_Convert_Float_To_Fixed): If the conversion
+	comes from an attribute reference 'Round, the operation must
+	round and not truncate.
+	* sem_res.adb, sem_ch6.adb: Minor editing.
+
 2015-11-12  Philippe Gil  <gil@adacore.com>
 
 	* g-debpoo.adb (Print_Address): print address in hexadecimal as

gcc/ada/exp_fixd.adb

@@ -37,6 +37,7 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
+with Snames;   use Snames;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -1695,6 +1696,7 @@ package body Exp_Fixd is
       Expr        : constant Node_Id   := Expression (N);
       Result_Type : constant Entity_Id := Etype (N);
       Small       : constant Ureal     := Small_Value (Result_Type);
+      Truncate    : Boolean;
 
    begin
       --  Optimize small = 1, where we can avoid the multiply completely
@@ -1704,14 +1706,25 @@ package body Exp_Fixd is
 
       --  Normal case where multiply is required
       --  Rounding is truncating for decimal fixed point types only,
-      --  see RM 4.6(29).
+      --  see RM 4.6(29), except if the conversion comes from an attribute
+      --  reference 'Round (RM 3.5.10 (14)): The attribute is implemented
+      --  by means of a conversion that must round.
 
       else
+         if Is_Decimal_Fixed_Point_Type (Result_Type) then
+            Truncate := Nkind (Original_Node (N)) /= N_Attribute_Reference
+               or else Get_Attribute_Id (Attribute_Name (Original_Node (N)))
+                /= Attribute_Round;
+         else
+            Truncate := False;
+         end if;
+
          Set_Result (N,
            Build_Multiply (N,
              Fpt_Value (Expr),
              Real_Literal (N, Ureal_1 / Small)),
-           Rng_Check, Trunc => Is_Decimal_Fixed_Point_Type (Result_Type));
+             Rng_Check,
+             Trunc => Truncate);
       end if;
    end Expand_Convert_Float_To_Fixed;
 

gcc/ada/init.c

@@ -2301,8 +2301,8 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
 #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.  */
+   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 *));
@@ -2323,17 +2323,19 @@ asm("\n"
 "	ldp	q12, q13, [x2, #480]\n"
 "	ldp	q14, q15, [x2, #512]\n"
 	/* Read FP from mcontext.  */
-"	ldp	fp, lr, [x2, #248]\n"
+"	ldr	fp, [x2, #248]\n"
 	/* Read SP and PC from mcontext.  */
-"	ldp	x6, x7, [x2, #264]\n"
-"	add	lr, x7, #1\n"
+"	ldp	x6, lr, [x2, #264]\n"
 "	mov	sp, x6\n"
-	/* Create a standard frame.  */
+	/* Create a minimal 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_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"
 );
 #endif
@@ -2416,6 +2418,9 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
       uc->uc_mcontext->__ss.__rbx = uc->uc_mcontext->__ss.__rdx;
       uc->uc_mcontext->__ss.__rdx = t;
     }
+#elif defined(__arm64__)
+  ucontext_t *uc = (ucontext_t *)ucontext;
+  uc->uc_mcontext->__ss.__pc++;
 #endif
 }
 
@@ -2447,6 +2452,16 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
       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,