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-2012, AdaCore -- 11-- -- 12-- GNAT 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 3, or (at your option) any later ver- -- 15-- sion. GNAT 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. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNARL was developed by the GNARL team at Florida State University. -- 29-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is the Alpha/VMS version 34 35with System.OS_Primitives; 36with System.Soft_Links; 37 38package body Ada.Calendar.Delays is 39 40 package OSP renames System.OS_Primitives; 41 package TSL renames System.Soft_Links; 42 43 use type TSL.Timed_Delay_Call; 44 45 ----------------------- 46 -- Local Subprograms -- 47 ----------------------- 48 49 procedure Timed_Delay_NT (Time : Duration; Mode : Integer); 50 -- Timed delay procedure used when no tasking is active 51 52 --------------- 53 -- Delay_For -- 54 --------------- 55 56 procedure Delay_For (D : Duration) is 57 begin 58 TSL.Timed_Delay.all 59 (Duration'Min (D, OSP.Max_Sensible_Delay), OSP.Relative); 60 end Delay_For; 61 62 ----------------- 63 -- Delay_Until -- 64 ----------------- 65 66 procedure Delay_Until (T : Time) is 67 begin 68 TSL.Timed_Delay.all (To_Duration (T), OSP.Absolute_Calendar); 69 end Delay_Until; 70 71 ----------------- 72 -- To_Duration -- 73 ----------------- 74 75 function To_Duration (T : Time) return Duration is 76 Safe_Ada_High : constant Time := Time_Of (2250, 1, 1, 0.0); 77 -- A value distant enough to emulate "end of time" but which does not 78 -- cause overflow. 79 80 Safe_T : constant Time := 81 (if T > Safe_Ada_High then Safe_Ada_High else T); 82 83 begin 84 return OSP.To_Duration (OSP.OS_Time (Safe_T), OSP.Absolute_Calendar); 85 end To_Duration; 86 87 -------------------- 88 -- Timed_Delay_NT -- 89 -------------------- 90 91 procedure Timed_Delay_NT (Time : Duration; Mode : Integer) is 92 begin 93 OSP.Timed_Delay (Time, Mode); 94 end Timed_Delay_NT; 95 96begin 97 -- Set up the Timed_Delay soft link to the non tasking version if it has 98 -- not been already set. If tasking is present, Timed_Delay has already set 99 -- this soft link, or this will be overridden during the elaboration of 100 -- System.Tasking.Initialization 101 102 if TSL.Timed_Delay = null then 103 TSL.Timed_Delay := Timed_Delay_NT'Access; 104 end if; 105end Ada.Calendar.Delays; 106