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-2014, 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
  37 pragma 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
  41 package 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    -- To_Duration --
  50    -----------------
  51
  52    function To_Duration (TS : timespec) return Duration is
  53    begin
  54       return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
  55    end To_Duration;
  56
  57    -----------------
  58    -- To_Timespec --
  59    -----------------
  60
  61    function To_Timespec (D : Duration) return timespec is
  62       S : time_t;
  63       F : Duration;
  64
  65    begin
  66       S := time_t (Long_Long_Integer (D));
  67       F := D - Duration (S);
  68
  69       --  If F is negative due to a round-up, adjust for positive F value
  70
  71       if F < 0.0 then
  72          S := S - 1;
  73          F := F + 1.0;
  74       end if;
  75
  76       return timespec'(ts_sec  => S,
  77                        ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
  78    end To_Timespec;
  79
  80    -------------------------
  81    -- To_VxWorks_Priority --
  82    -------------------------
  83
  84    function To_VxWorks_Priority (Priority : int) return int is
  85    begin
  86       return Low_Priority - Priority;
  87    end To_VxWorks_Priority;
  88
  89    --------------------
  90    -- To_Clock_Ticks --
  91    --------------------
  92
  93    --  ??? - For now, we'll always get the system clock rate since it is
  94    --  allowed to be changed during run-time in VxWorks. A better method would
  95    --  be to provide an operation to set it that so we can always know its
  96    --  value.
  97
  98    --  Another thing we should probably allow for is a resultant tick count
  99    --  greater than int'Last. This should probably be a procedure with two
 100    --  output parameters, one in the range 0 .. int'Last, and another
 101    --  representing the overflow count.
 102
 103    function To_Clock_Ticks (D : Duration) return int is
 104       Ticks          : Long_Long_Integer;
 105       Rate_Duration  : Duration;
 106       Ticks_Duration : Duration;
 107
 108    begin
 109       if D < 0.0 then
 110          return ERROR;
 111       end if;
 112
 113       --  Ensure that the duration can be converted to ticks
 114       --  at the current clock tick rate without overflowing.
 115
 116       Rate_Duration := Duration (sysClkRateGet);
 117
 118       if D > (Duration'Last / Rate_Duration) then
 119          Ticks := Long_Long_Integer (int'Last);
 120       else
 121          Ticks_Duration := D * Rate_Duration;
 122          Ticks := Long_Long_Integer (Ticks_Duration);
 123
 124          if Ticks_Duration > Duration (Ticks) then
 125             Ticks := Ticks + 1;
 126          end if;
 127
 128          if Ticks > Long_Long_Integer (int'Last) then
 129             Ticks := Long_Long_Integer (int'Last);
 130          end if;
 131       end if;
 132
 133       return int (Ticks);
 134    end To_Clock_Ticks;
 135
 136    -----------------------------
 137    -- Binary_Semaphore_Create --
 138    -----------------------------
 139
 140    function Binary_Semaphore_Create return Binary_Semaphore_Id is
 141    begin
 142       return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY));
 143    end Binary_Semaphore_Create;
 144
 145    -----------------------------
 146    -- Binary_Semaphore_Delete --
 147    -----------------------------
 148
 149    function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
 150    begin
 151       return semDelete (SEM_ID (ID));
 152    end Binary_Semaphore_Delete;
 153
 154    -----------------------------
 155    -- Binary_Semaphore_Obtain --
 156    -----------------------------
 157
 158    function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
 159    begin
 160       return semTake (SEM_ID (ID), WAIT_FOREVER);
 161    end Binary_Semaphore_Obtain;
 162
 163    ------------------------------
 164    -- Binary_Semaphore_Release --
 165    ------------------------------
 166
 167    function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
 168    begin
 169       return semGive (SEM_ID (ID));
 170    end Binary_Semaphore_Release;
 171
 172    ----------------------------
 173    -- Binary_Semaphore_Flush --
 174    ----------------------------
 175
 176    function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
 177    begin
 178       return semFlush (SEM_ID (ID));
 179    end Binary_Semaphore_Flush;
 180
 181    ----------
 182    -- kill --
 183    ----------
 184
 185    function kill (pid : t_id; sig : Signal) return int is
 186    begin
 187       return System.VxWorks.Ext.kill (pid, int (sig));
 188    end kill;
 189
 190    -----------------------
 191    -- Interrupt_Connect --
 192    -----------------------
 193
 194    function Interrupt_Connect
 195      (Vector    : Interrupt_Vector;
 196       Handler   : Interrupt_Handler;
 197       Parameter : System.Address := System.Null_Address) return int is
 198    begin
 199       return
 200         System.VxWorks.Ext.Interrupt_Connect
 201         (System.VxWorks.Ext.Interrupt_Vector (Vector),
 202          System.VxWorks.Ext.Interrupt_Handler (Handler),
 203          Parameter);
 204    end Interrupt_Connect;
 205
 206    -----------------------
 207    -- Interrupt_Context --
 208    -----------------------
 209
 210    function Interrupt_Context return int is
 211    begin
 212       return System.VxWorks.Ext.Interrupt_Context;
 213    end Interrupt_Context;
 214
 215    --------------------------------
 216    -- Interrupt_Number_To_Vector --
 217    --------------------------------
 218
 219    function Interrupt_Number_To_Vector
 220      (intNum : int) return Interrupt_Vector
 221    is
 222    begin
 223       return Interrupt_Vector
 224         (System.VxWorks.Ext.Interrupt_Number_To_Vector (intNum));
 225    end Interrupt_Number_To_Vector;
 226
 227    -----------------
 228    -- Current_CPU --
 229    -----------------
 230
 231    function Current_CPU return Multiprocessors.CPU is
 232    begin
 233       --  ??? Should use vxworks multiprocessor interface
 234
 235       return Multiprocessors.CPU'First;
 236    end Current_CPU;
 237
 238 end System.OS_Interface;