gcc/ada/s-osinte-vxworks.adb

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