gcc/ada/s-osinte-vxworks.adb

   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-2007, 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 2,  or (at your option) any later ver- --
  14 -- sion. GNARL 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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNARL was developed by the GNARL team at Florida State University.       --
  30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  This is the VxWorks version
  35
  36 --  This package encapsulates all direct interfaces to OS services that are
  37 --  needed by children of System.
  38
  39 pragma Polling (Off);
  40 --  Turn off polling, we do not want ATC polling to take place during tasking
  41 --  operations. It causes infinite loops and other problems.
  42
  43 package body System.OS_Interface is
  44
  45    use type Interfaces.C.int;
  46
  47    Low_Priority : constant := 255;
  48    --  VxWorks native (default) lowest scheduling priority
  49
  50    ------------
  51    -- getpid --
  52    ------------
  53
  54    function getpid return t_id is
  55    begin
  56       --  VxWorks 5 (and VxWorks 6 in kernel mode) does not have a getpid
  57       --  function. taskIdSelf is the equivalent routine.
  58
  59       return taskIdSelf;
  60    end getpid;
  61
  62    --------------
  63    -- Int_Lock --
  64    --------------
  65
  66    function Int_Lock return int is
  67       function intLock return int;
  68       pragma Import (C, intLock, "intLock");
  69    begin
  70       return intLock;
  71    end Int_Lock;
  72
  73    ----------------
  74    -- Int_Unlock --
  75    ----------------
  76
  77    function Int_Unlock return int is
  78       function intUnlock return int;
  79       pragma Import (C, intUnlock, "intUnlock");
  80    begin
  81       return intUnlock;
  82    end Int_Unlock;
  83
  84    ----------
  85    -- kill --
  86    ----------
  87
  88    function kill (pid : t_id; sig : Signal) return int is
  89       function c_kill (pid : t_id; sig : Signal) return int;
  90       pragma Import (C, c_kill, "kill");
  91    begin
  92       return c_kill (pid, sig);
  93    end kill;
  94
  95    --------------------
  96    -- Set_Time_Slice --
  97    --------------------
  98
  99    function Set_Time_Slice (ticks : int) return int is
 100       function kernelTimeSlice (ticks : int) return int;
 101       pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
 102    begin
 103       return kernelTimeSlice (ticks);
 104    end Set_Time_Slice;
 105
 106    -------------
 107    -- sigwait --
 108    -------------
 109
 110    function sigwait
 111      (set : access sigset_t;
 112       sig : access Signal) return int
 113    is
 114       Result : int;
 115
 116       function sigwaitinfo
 117         (set : access sigset_t; sigvalue : System.Address) return int;
 118       pragma Import (C, sigwaitinfo, "sigwaitinfo");
 119
 120    begin
 121       Result := sigwaitinfo (set, System.Null_Address);
 122
 123       if Result /= -1 then
 124          sig.all := Signal (Result);
 125          return 0;
 126       else
 127          sig.all := 0;
 128          return errno;
 129       end if;
 130    end sigwait;
 131
 132    ---------------
 133    -- Task_Cont --
 134    ---------------
 135
 136    function Task_Cont (tid : t_id) return int is
 137       function taskResume (tid : t_id) return int;
 138       pragma Import (C, taskResume, "taskResume");
 139    begin
 140       return taskResume (tid);
 141    end Task_Cont;
 142
 143    ---------------
 144    -- Task_Stop --
 145    ---------------
 146
 147    function Task_Stop (tid : t_id) return int is
 148       function taskSuspend (tid : t_id) return int;
 149       pragma Import (C, taskSuspend, "taskSuspend");
 150    begin
 151       return taskSuspend (tid);
 152    end Task_Stop;
 153
 154    -----------------
 155    -- To_Duration --
 156    -----------------
 157
 158    function To_Duration (TS : timespec) return Duration is
 159    begin
 160       return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
 161    end To_Duration;
 162
 163    -----------------
 164    -- To_Timespec --
 165    -----------------
 166
 167    function To_Timespec (D : Duration) return timespec is
 168       S : time_t;
 169       F : Duration;
 170
 171    begin
 172       S := time_t (Long_Long_Integer (D));
 173       F := D - Duration (S);
 174
 175       --  If F is negative due to a round-up, adjust for positive F value
 176
 177       if F < 0.0 then
 178          S := S - 1;
 179          F := F + 1.0;
 180       end if;
 181
 182       return timespec'(ts_sec  => S,
 183                        ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
 184    end To_Timespec;
 185
 186    -------------------------
 187    -- To_VxWorks_Priority --
 188    -------------------------
 189
 190    function To_VxWorks_Priority (Priority : int) return int is
 191    begin
 192       return Low_Priority - Priority;
 193    end To_VxWorks_Priority;
 194
 195    --------------------
 196    -- To_Clock_Ticks --
 197    --------------------
 198
 199    --  ??? - For now, we'll always get the system clock rate since it is
 200    --  allowed to be changed during run-time in VxWorks. A better method would
 201    --  be to provide an operation to set it that so we can always know its
 202    --  value.
 203
 204    --  Another thing we should probably allow for is a resultant tick count
 205    --  greater than int'Last. This should probably be a procedure with two
 206    --  output parameters, one in the range 0 .. int'Last, and another
 207    --  representing the overflow count.
 208
 209    function To_Clock_Ticks (D : Duration) return int is
 210       Ticks          : Long_Long_Integer;
 211       Rate_Duration  : Duration;
 212       Ticks_Duration : Duration;
 213
 214    begin
 215       if D < 0.0 then
 216          return -1;
 217       end if;
 218
 219       --  Ensure that the duration can be converted to ticks
 220       --  at the current clock tick rate without overflowing.
 221
 222       Rate_Duration := Duration (sysClkRateGet);
 223
 224       if D > (Duration'Last / Rate_Duration) then
 225          Ticks := Long_Long_Integer (int'Last);
 226       else
 227          Ticks_Duration := D * Rate_Duration;
 228          Ticks := Long_Long_Integer (Ticks_Duration);
 229
 230          if Ticks_Duration > Duration (Ticks) then
 231             Ticks := Ticks + 1;
 232          end if;
 233
 234          if Ticks > Long_Long_Integer (int'Last) then
 235             Ticks := Long_Long_Integer (int'Last);
 236          end if;
 237       end if;
 238
 239       return int (Ticks);
 240    end To_Clock_Ticks;
 241
 242 end System.OS_Interface;