1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . O S _ I N T E R F A C E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1997-2011, 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 is the VxWorks version 33 34-- This package encapsulates all direct interfaces to OS services that are 35-- needed by children of System. 36 37pragma Polling (Off); 38-- Turn off polling, we do not want ATC polling to take place during tasking 39-- operations. It causes infinite loops and other problems. 40 41package body System.OS_Interface is 42 43 use type Interfaces.C.int; 44 45 Low_Priority : constant := 255; 46 -- VxWorks native (default) lowest scheduling priority 47 48 ------------- 49 -- sigwait -- 50 ------------- 51 52 function sigwait 53 (set : access sigset_t; 54 sig : access Signal) return int 55 is 56 Result : int; 57 58 function sigwaitinfo 59 (set : access sigset_t; sigvalue : System.Address) return int; 60 pragma Import (C, sigwaitinfo, "sigwaitinfo"); 61 62 begin 63 Result := sigwaitinfo (set, System.Null_Address); 64 65 if Result /= -1 then 66 sig.all := Signal (Result); 67 return OK; 68 else 69 sig.all := 0; 70 return errno; 71 end if; 72 end sigwait; 73 74 ----------------- 75 -- To_Duration -- 76 ----------------- 77 78 function To_Duration (TS : timespec) return Duration is 79 begin 80 return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; 81 end To_Duration; 82 83 ----------------- 84 -- To_Timespec -- 85 ----------------- 86 87 function To_Timespec (D : Duration) return timespec is 88 S : time_t; 89 F : Duration; 90 91 begin 92 S := time_t (Long_Long_Integer (D)); 93 F := D - Duration (S); 94 95 -- If F is negative due to a round-up, adjust for positive F value 96 97 if F < 0.0 then 98 S := S - 1; 99 F := F + 1.0; 100 end if; 101 102 return timespec'(ts_sec => S, 103 ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); 104 end To_Timespec; 105 106 ------------------------- 107 -- To_VxWorks_Priority -- 108 ------------------------- 109 110 function To_VxWorks_Priority (Priority : int) return int is 111 begin 112 return Low_Priority - Priority; 113 end To_VxWorks_Priority; 114 115 -------------------- 116 -- To_Clock_Ticks -- 117 -------------------- 118 119 -- ??? - For now, we'll always get the system clock rate since it is 120 -- allowed to be changed during run-time in VxWorks. A better method would 121 -- be to provide an operation to set it that so we can always know its 122 -- value. 123 124 -- Another thing we should probably allow for is a resultant tick count 125 -- greater than int'Last. This should probably be a procedure with two 126 -- output parameters, one in the range 0 .. int'Last, and another 127 -- representing the overflow count. 128 129 function To_Clock_Ticks (D : Duration) return int is 130 Ticks : Long_Long_Integer; 131 Rate_Duration : Duration; 132 Ticks_Duration : Duration; 133 134 begin 135 if D < 0.0 then 136 return ERROR; 137 end if; 138 139 -- Ensure that the duration can be converted to ticks 140 -- at the current clock tick rate without overflowing. 141 142 Rate_Duration := Duration (sysClkRateGet); 143 144 if D > (Duration'Last / Rate_Duration) then 145 Ticks := Long_Long_Integer (int'Last); 146 else 147 Ticks_Duration := D * Rate_Duration; 148 Ticks := Long_Long_Integer (Ticks_Duration); 149 150 if Ticks_Duration > Duration (Ticks) then 151 Ticks := Ticks + 1; 152 end if; 153 154 if Ticks > Long_Long_Integer (int'Last) then 155 Ticks := Long_Long_Integer (int'Last); 156 end if; 157 end if; 158 159 return int (Ticks); 160 end To_Clock_Ticks; 161 162 ----------------------------- 163 -- Binary_Semaphore_Create -- 164 ----------------------------- 165 166 function Binary_Semaphore_Create return Binary_Semaphore_Id is 167 begin 168 return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY)); 169 end Binary_Semaphore_Create; 170 171 ----------------------------- 172 -- Binary_Semaphore_Delete -- 173 ----------------------------- 174 175 function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is 176 begin 177 return semDelete (SEM_ID (ID)); 178 end Binary_Semaphore_Delete; 179 180 ----------------------------- 181 -- Binary_Semaphore_Obtain -- 182 ----------------------------- 183 184 function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is 185 begin 186 return semTake (SEM_ID (ID), WAIT_FOREVER); 187 end Binary_Semaphore_Obtain; 188 189 ------------------------------ 190 -- Binary_Semaphore_Release -- 191 ------------------------------ 192 193 function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is 194 begin 195 return semGive (SEM_ID (ID)); 196 end Binary_Semaphore_Release; 197 198 ---------------------------- 199 -- Binary_Semaphore_Flush -- 200 ---------------------------- 201 202 function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is 203 begin 204 return semFlush (SEM_ID (ID)); 205 end Binary_Semaphore_Flush; 206 207 ---------- 208 -- kill -- 209 ---------- 210 211 function kill (pid : t_id; sig : Signal) return int is 212 begin 213 return System.VxWorks.Ext.kill (pid, int (sig)); 214 end kill; 215 216 ----------------------- 217 -- Interrupt_Connect -- 218 ----------------------- 219 220 function Interrupt_Connect 221 (Vector : Interrupt_Vector; 222 Handler : Interrupt_Handler; 223 Parameter : System.Address := System.Null_Address) return int is 224 begin 225 return 226 System.VxWorks.Ext.Interrupt_Connect 227 (System.VxWorks.Ext.Interrupt_Vector (Vector), 228 System.VxWorks.Ext.Interrupt_Handler (Handler), 229 Parameter); 230 end Interrupt_Connect; 231 232 ----------------------- 233 -- Interrupt_Context -- 234 ----------------------- 235 236 function Interrupt_Context return int is 237 begin 238 return System.VxWorks.Ext.Interrupt_Context; 239 end Interrupt_Context; 240 241 -------------------------------- 242 -- Interrupt_Number_To_Vector -- 243 -------------------------------- 244 245 function Interrupt_Number_To_Vector 246 (intNum : int) return Interrupt_Vector 247 is 248 begin 249 return Interrupt_Vector 250 (System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum)); 251 end Interrupt_Number_To_Vector; 252 253 ----------------- 254 -- Current_CPU -- 255 ----------------- 256 257 function Current_CPU return Multiprocessors.CPU is 258 begin 259 -- ??? Should use vxworks multiprocessor interface 260 261 return Multiprocessors.CPU'First; 262 end Current_CPU; 263 264end System.OS_Interface; 265