diff mbox

[Ada] Preliminary work to support relative delays on extended ravenscar

Message ID 20161012122731.GA98898@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 12, 2016, 12:27 p.m. UTC
Tested on x86_64-pc-linux-gnu, committed on trunk

2016-10-12  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Expand_N_Delay_Relative_Statement): Add support
	for a secondary procedure in case of missing Ada.Calendar.Delays
	* rtsfind.ads (RTU_Id): Add System_Relative_Delays.
	(RE_Id): Add RO_RD_Delay_For.
	* rtsfind.adb (Output_Entity_Name): Handle correctly units RO_XX.
	* s-rident.ads: Remove No_Relative_Delays
	restriction for GNAT_Extended_Ravenscar.
diff mbox

Patch

Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 241029)
+++ exp_ch9.adb	(working copy)
@@ -8388,11 +8388,23 @@ 
    --  simple delays imposed by the use of Protected Objects.
 
    procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
+      Loc  : constant Source_Ptr := Sloc (N);
+      Proc : Entity_Id;
    begin
+      if RTE_Available (RO_RD_Delay_For) then
+         --  Try to use System.Relative_Delays.Delay_For only if available.
+         --  This is the implementation used on restricted platforms when
+         --  Ada.Calendar is not available.
+         Proc := RTE (RO_RD_Delay_For);
+      else
+         --  Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error
+         --  message if not available.
+         Proc := RTE (RO_CA_Delay_For);
+      end if;
+
       Rewrite (N,
         Make_Procedure_Call_Statement (Loc,
-          Name => New_Occurrence_Of (RTE (RO_CA_Delay_For), Loc),
+          Name => New_Occurrence_Of (Proc, Loc),
           Parameter_Associations => New_List (Expression (N))));
       Analyze (N);
    end Expand_N_Delay_Relative_Statement;
Index: rtsfind.adb
===================================================================
--- rtsfind.adb	(revision 241024)
+++ rtsfind.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -1144,6 +1144,9 @@ 
       --  M (1 .. P) is current message to be output
 
       RE_Image : constant String := RE_Id'Image (Id);
+      S : Natural;
+      --  RE_Image (S .. RE_Image'Last) is the name of the entity without the
+      --  "RE_" or "RO_XX_" prefix.
 
    begin
       if Id = RE_Null then
@@ -1168,8 +1171,15 @@ 
 
       --  Add entity name and closing quote to message
 
-      Name_Len := RE_Image'Length - 3;
-      Name_Buffer (1 .. Name_Len) := RE_Image (4 .. RE_Image'Length);
+      if RE_Image (2) = 'E' then
+         --  Strip "RE"
+         S := 4;
+      else
+         --  Strip "RO_XX"
+         S := 7;
+      end if;
+      Name_Len := RE_Image'Length - S + 1;
+      Name_Buffer (1 .. Name_Len) := RE_Image (S .. RE_Image'Last);
       Set_Casing (Mixed_Case);
       M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len);
       P := P + Name_Len;
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 241024)
+++ rtsfind.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -349,6 +349,7 @@ 
       System_Pool_Empty,
       System_Pool_Local,
       System_Pool_Size,
+      System_Relative_Delays,
       System_RPC,
       System_Scalar_Values,
       System_Secondary_Stack,
@@ -1403,6 +1404,8 @@ 
      RE_Tk_Objref,                       -- System.Partition_Interface
      RE_Tk_Union,                        -- System.Partition_Interface
 
+     RO_RD_Delay_For,                    -- System.Relative_Delays
+
      RE_IS_Is1,                          -- System.Scalar_Values
      RE_IS_Is2,                          -- System.Scalar_Values
      RE_IS_Is4,                          -- System.Scalar_Values
@@ -2635,6 +2638,8 @@ 
 
      RE_Stack_Bounded_Pool               => System_Pool_Size,
 
+     RO_RD_Delay_For                     => System_Relative_Delays,
+
      RE_Do_Apc                           => System_RPC,
      RE_Do_Rpc                           => System_RPC,
      RE_Params_Stream_Type               => System_RPC,
Index: s-rident.ads
===================================================================
--- s-rident.ads	(revision 241026)
+++ s-rident.ads	(working copy)
@@ -574,7 +574,6 @@ 
                            No_Implicit_Protected_Object_Allocations
                                                             => True,
                            No_Local_Timing_Events           => True,
-                           No_Relative_Delay                => True,
                            No_Select_Statements             => True,
                            No_Specific_Termination_Handlers => True,
                            No_Task_Termination              => True,