2010-07-27 Paolo Carlini <paolo.carlini@oracle.com>
[official-gcc/alias-decl.git] / gcc / ada / a-caldel.adb
blob17b399777145e2e900bb1c0fe5056531eaee0a88
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- A D A . C A L E N D A R . D E L A Y S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2008, AdaCore --
11 -- --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
22 -- --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
29 -- --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 -- --
33 ------------------------------------------------------------------------------
35 with System.OS_Primitives;
36 with System.Soft_Links;
37 with System.Traces;
38 with System.Parameters;
40 package body Ada.Calendar.Delays is
42 package OSP renames System.OS_Primitives;
43 package SSL renames System.Soft_Links;
45 use type SSL.Timed_Delay_Call;
47 use System.Traces;
49 -- Earlier, System.Time_Operations was used to implement the following
50 -- operations. The idea was to avoid sucking in the tasking packages. This
51 -- did not work. Logically, we can't have it both ways. There is no way to
52 -- implement time delays that will have correct task semantics without
53 -- reference to the tasking run-time system. To achieve this goal, we now
54 -- use soft links.
56 -----------------------
57 -- Local Subprograms --
58 -----------------------
60 procedure Timed_Delay_NT (Time : Duration; Mode : Integer);
61 -- Timed delay procedure used when no tasking is active
63 ---------------
64 -- Delay_For --
65 ---------------
67 procedure Delay_For (D : Duration) is
68 begin
69 if System.Parameters.Runtime_Traces then
70 Send_Trace_Info (W_Delay, D);
71 end if;
73 SSL.Timed_Delay.all (Duration'Min (D, OSP.Max_Sensible_Delay),
74 OSP.Relative);
76 if System.Parameters.Runtime_Traces then
77 Send_Trace_Info (M_Delay, D);
78 end if;
79 end Delay_For;
81 -----------------
82 -- Delay_Until --
83 -----------------
85 procedure Delay_Until (T : Time) is
86 D : constant Duration := To_Duration (T);
88 begin
89 if System.Parameters.Runtime_Traces then
90 Send_Trace_Info (WU_Delay, D);
91 end if;
93 SSL.Timed_Delay.all (D, OSP.Absolute_Calendar);
95 if System.Parameters.Runtime_Traces then
96 Send_Trace_Info (M_Delay, D);
97 end if;
98 end Delay_Until;
100 --------------------
101 -- Timed_Delay_NT --
102 --------------------
104 procedure Timed_Delay_NT (Time : Duration; Mode : Integer) is
105 begin
106 OSP.Timed_Delay (Time, Mode);
107 end Timed_Delay_NT;
109 -----------------
110 -- To_Duration --
111 -----------------
113 function To_Duration (T : Time) return Duration is
114 begin
115 -- Since time has multiple representations on different platforms, a
116 -- target independent operation in Ada.Calendar is used to perform
117 -- this conversion.
119 return Delay_Operations.To_Duration (T);
120 end To_Duration;
122 begin
123 -- Set up the Timed_Delay soft link to the non tasking version if it has
124 -- not been already set. If tasking is present, Timed_Delay has already set
125 -- this soft link, or this will be overridden during the elaboration of
126 -- System.Tasking.Initialization
128 if SSL.Timed_Delay = null then
129 SSL.Timed_Delay := Timed_Delay_NT'Access;
130 end if;
132 end Ada.Calendar.Delays;