gcc/ada/libgnarl/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-2024, 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 package body System.OS_Interface is
  38
  39    use type Interfaces.C.int;
  40
  41    Low_Priority : constant := 255;
  42    --  VxWorks native (default) lowest scheduling priority
  43
  44    -----------------
  45    -- To_Duration --
  46    -----------------
  47
  48    function To_Duration (TS : timespec) return Duration is
  49    begin
  50       return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
  51    end To_Duration;
  52
  53    -----------------
  54    -- To_Timespec --
  55    -----------------
  56
  57    function To_Timespec (D : Duration) return timespec is
  58       S : time_t;
  59       F : Duration;
  60
  61    begin
  62       S := time_t (Long_Long_Integer (D));
  63       F := D - Duration (S);
  64
  65       --  If F is negative due to a round-up, adjust for positive F value
  66
  67       if F < 0.0 then
  68          S := S - 1;
  69          F := F + 1.0;
  70       end if;
  71
  72       return timespec'(ts_sec  => S,
  73                        ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
  74    end To_Timespec;
  75
  76    -------------------------
  77    -- To_VxWorks_Priority --
  78    -------------------------
  79
  80    function To_VxWorks_Priority (Priority : int) return int is
  81    begin
  82       return Low_Priority - Priority;
  83    end To_VxWorks_Priority;
  84
  85    --------------------
  86    -- To_Clock_Ticks --
  87    --------------------
  88
  89    --  ??? - For now, we'll always get the system clock rate since it is
  90    --  allowed to be changed during run-time in VxWorks. A better method would
  91    --  be to provide an operation to set it that so we can always know its
  92    --  value.
  93
  94    --  Another thing we should probably allow for is a resultant tick count
  95    --  greater than int'Last. This should probably be a procedure with two
  96    --  output parameters, one in the range 0 .. int'Last, and another
  97    --  representing the overflow count.
  98
  99    function To_Clock_Ticks (D : Duration) return int is
 100       Ticks          : Long_Long_Integer;
 101       Rate_Duration  : Duration;
 102       Ticks_Duration : Duration;
 103       IERR           : constant int := -1;
 104
 105    begin
 106       if D < 0.0 then
 107          return IERR;
 108       end if;
 109
 110       --  Ensure that the duration can be converted to ticks
 111       --  at the current clock tick rate without overflowing.
 112
 113       Rate_Duration := Duration (sysClkRateGet);
 114
 115       if D > (Duration'Last / Rate_Duration) then
 116          Ticks := Long_Long_Integer (int'Last);
 117       else
 118          Ticks_Duration := D * Rate_Duration;
 119          Ticks := Long_Long_Integer (Ticks_Duration);
 120
 121          if Ticks_Duration > Duration (Ticks) then
 122             Ticks := Ticks + 1;
 123          end if;
 124
 125          if Ticks > Long_Long_Integer (int'Last) then
 126             Ticks := Long_Long_Integer (int'Last);
 127          end if;
 128       end if;
 129
 130       return int (Ticks);
 131    end To_Clock_Ticks;
 132
 133    -----------------------------
 134    -- Binary_Semaphore_Create --
 135    -----------------------------
 136
 137    function Binary_Semaphore_Create return Binary_Semaphore_Id is
 138    begin
 139       return Binary_Semaphore_Id (semBCreate (SEM_Q_FIFO, SEM_EMPTY));
 140    end Binary_Semaphore_Create;
 141
 142    -----------------------------
 143    -- Binary_Semaphore_Delete --
 144    -----------------------------
 145
 146    function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id)
 147      return STATUS is
 148    begin
 149       return semDelete (SEM_ID (ID));
 150    end Binary_Semaphore_Delete;
 151
 152    -----------------------------
 153    -- Binary_Semaphore_Obtain --
 154    -----------------------------
 155
 156    function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id)
 157      return STATUS is
 158    begin
 159       return semTake (SEM_ID (ID), WAIT_FOREVER);
 160    end Binary_Semaphore_Obtain;
 161
 162    ------------------------------
 163    -- Binary_Semaphore_Release --
 164    ------------------------------
 165
 166    function Binary_Semaphore_Release (ID : Binary_Semaphore_Id)
 167      return STATUS 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 STATUS 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 STATUS 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 BOOL 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;