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