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-2006 Free Software Foundation             --
  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
  37 --  that are needed by children of System.
  38
  39 pragma Polling (Off);
  40 --  Turn off polling, we do not want ATC polling to take place during
  41 --  tasking 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    -- kill --
  64    ----------
  65
  66    function kill (pid : t_id; sig : Signal) return int is
  67       function c_kill (pid : t_id; sig : Signal) return int;
  68       pragma Import (C, c_kill, "kill");
  69    begin
  70       return c_kill (pid, sig);
  71    end kill;
  72
  73    --------------------
  74    -- Set_Time_Slice --
  75    --------------------
  76
  77    function Set_Time_Slice (ticks : int) return int is
  78       function kernelTimeSlice (ticks : int) return int;
  79       pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
  80    begin
  81       return kernelTimeSlice (ticks);
  82    end Set_Time_Slice;
  83
  84    -------------
  85    -- sigwait --
  86    -------------
  87
  88    function sigwait
  89      (set : access sigset_t;
  90       sig : access Signal) return int
  91    is
  92       Result : int;
  93
  94       function sigwaitinfo
  95         (set : access sigset_t; sigvalue : System.Address) return int;
  96       pragma Import (C, sigwaitinfo, "sigwaitinfo");
  97
  98    begin
  99       Result := sigwaitinfo (set, System.Null_Address);
 100
 101       if Result /= -1 then
 102          sig.all := Signal (Result);
 103          return 0;
 104       else
 105          sig.all := 0;
 106          return errno;
 107       end if;
 108    end sigwait;
 109
 110    -----------------
 111    -- To_Duration --
 112    -----------------
 113
 114    function To_Duration (TS : timespec) return Duration is
 115    begin
 116       return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
 117    end To_Duration;
 118
 119    -----------------
 120    -- To_Timespec --
 121    -----------------
 122
 123    function To_Timespec (D : Duration) return timespec is
 124       S : time_t;
 125       F : Duration;
 126    begin
 127       S := time_t (Long_Long_Integer (D));
 128       F := D - Duration (S);
 129
 130       --  If F has negative value due to a round-up, adjust for positive F
 131       --  value.
 132       if F < 0.0 then
 133          S := S - 1;
 134          F := F + 1.0;
 135       end if;
 136
 137       return timespec'(ts_sec  => S,
 138                        ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
 139    end To_Timespec;
 140
 141    -------------------------
 142    -- To_VxWorks_Priority --
 143    -------------------------
 144
 145    function To_VxWorks_Priority (Priority : in int) return int is
 146    begin
 147       return Low_Priority - Priority;
 148    end To_VxWorks_Priority;
 149
 150    --------------------
 151    -- To_Clock_Ticks --
 152    --------------------
 153
 154    --  ??? - For now, we'll always get the system clock rate
 155    --  since it is allowed to be changed during run-time in
 156    --  VxWorks. A better method would be to provide an operation
 157    --  to set it that so we can always know its value.
 158    --
 159    --  Another thing we should probably allow for is a resultant
 160    --  tick count greater than int'Last. This should probably
 161    --  be a procedure with two output parameters, one in the
 162    --  range 0 .. int'Last, and another representing the overflow
 163    --  count.
 164
 165    function To_Clock_Ticks (D : Duration) return int is
 166       Ticks          : Long_Long_Integer;
 167       Rate_Duration  : Duration;
 168       Ticks_Duration : Duration;
 169
 170    begin
 171       if D < 0.0 then
 172          return -1;
 173       end if;
 174
 175       --  Ensure that the duration can be converted to ticks
 176       --  at the current clock tick rate without overflowing.
 177
 178       Rate_Duration := Duration (sysClkRateGet);
 179
 180       if D > (Duration'Last / Rate_Duration) then
 181          Ticks := Long_Long_Integer (int'Last);
 182       else
 183          Ticks_Duration := D * Rate_Duration;
 184          Ticks := Long_Long_Integer (Ticks_Duration);
 185
 186          if Ticks_Duration > Duration (Ticks) then
 187             Ticks := Ticks + 1;
 188          end if;
 189
 190          if Ticks > Long_Long_Integer (int'Last) then
 191             Ticks := Long_Long_Integer (int'Last);
 192          end if;
 193       end if;
 194
 195       return int (Ticks);
 196    end To_Clock_Ticks;
 197
 198    ----------------
 199    -- VX_FP_TASK --
 200    ----------------
 201
 202    function VX_FP_TASK return int is
 203    begin
 204       return 16#0008#;
 205    end VX_FP_TASK;
 206
 207 end System.OS_Interface;