1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . O S _ P R I M I T I V E S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1998-2015, Free Software Foundation, Inc. -- 10-- -- 11-- GNARL is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This version is for VxWorks targets 33 34with System.OS_Interface; 35-- Since the thread library is part of the VxWorks kernel, using OS_Interface 36-- is not a problem here, as long as we only use System.OS_Interface as a 37-- set of C imported routines: using Ada routines from this package would 38-- create a dependency on libgnarl in libgnat, which is not desirable. 39 40with System.OS_Constants; 41with Interfaces.C; 42 43package body System.OS_Primitives is 44 45 use System.OS_Interface; 46 use type Interfaces.C.int; 47 48 package OSC renames System.OS_Constants; 49 50 ------------------------ 51 -- Internal functions -- 52 ------------------------ 53 54 function To_Clock_Ticks (D : Duration) return int; 55 -- Convert a duration value (in seconds) into clock ticks. 56 -- Note that this routine is duplicated from System.OS_Interface since 57 -- as explained above, we do not want to depend on libgnarl 58 59 function To_Clock_Ticks (D : Duration) return int is 60 Ticks : Long_Long_Integer; 61 Rate_Duration : Duration; 62 Ticks_Duration : Duration; 63 64 begin 65 if D < 0.0 then 66 return -1; 67 end if; 68 69 -- Ensure that the duration can be converted to ticks 70 -- at the current clock tick rate without overflowing. 71 72 Rate_Duration := Duration (sysClkRateGet); 73 74 if D > (Duration'Last / Rate_Duration) then 75 Ticks := Long_Long_Integer (int'Last); 76 else 77 Ticks_Duration := D * Rate_Duration; 78 Ticks := Long_Long_Integer (Ticks_Duration); 79 80 if Ticks_Duration > Duration (Ticks) then 81 Ticks := Ticks + 1; 82 end if; 83 84 if Ticks > Long_Long_Integer (int'Last) then 85 Ticks := Long_Long_Integer (int'Last); 86 end if; 87 end if; 88 89 return int (Ticks); 90 end To_Clock_Ticks; 91 92 ----------- 93 -- Clock -- 94 ----------- 95 96 function Clock return Duration is 97 TS : aliased timespec; 98 Result : int; 99 begin 100 Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access); 101 pragma Assert (Result = 0); 102 return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; 103 end Clock; 104 105 ----------------- 106 -- Timed_Delay -- 107 ----------------- 108 109 procedure Timed_Delay 110 (Time : Duration; 111 Mode : Integer) 112 is 113 Rel_Time : Duration; 114 Abs_Time : Duration; 115 Base_Time : constant Duration := Clock; 116 Check_Time : Duration := Base_Time; 117 Ticks : int; 118 119 Result : int; 120 pragma Unreferenced (Result); 121 122 begin 123 if Mode = Relative then 124 Rel_Time := Time; 125 Abs_Time := Time + Check_Time; 126 else 127 Rel_Time := Time - Check_Time; 128 Abs_Time := Time; 129 end if; 130 131 if Rel_Time > 0.0 then 132 loop 133 Ticks := To_Clock_Ticks (Rel_Time); 134 135 if Mode = Relative and then Ticks < int'Last then 136 -- The first tick will delay anytime between 0 and 137 -- 1 / sysClkRateGet seconds, so we need to add one to 138 -- be on the safe side. 139 140 Ticks := Ticks + 1; 141 end if; 142 143 Result := taskDelay (Ticks); 144 Check_Time := Clock; 145 146 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; 147 148 Rel_Time := Abs_Time - Check_Time; 149 end loop; 150 end if; 151 end Timed_Delay; 152 153 ---------------- 154 -- Initialize -- 155 ---------------- 156 157 procedure Initialize is 158 begin 159 null; 160 end Initialize; 161 162end System.OS_Primitives; 163