gcc/ada/libgnarl/s-osinte__lynxos178.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) 2001-2020, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT 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 --  Version of System.OS_Interface for LynxOS-178 (POSIX Threads)
  33
  34 package body System.OS_Interface is
  35
  36    ------------------
  37    --  Current_CPU --
  38    ------------------
  39
  40    function Current_CPU return Multiprocessors.CPU is
  41    begin
  42       --  No multiprocessor support, always return the first CPU Id
  43
  44       return Multiprocessors.CPU'First;
  45    end Current_CPU;
  46
  47    --------------------
  48    --  Get_Affinity  --
  49    --------------------
  50
  51    function Get_Affinity (Id : Thread_Id) return Multiprocessors.CPU_Range is
  52       pragma Unreferenced (Id);
  53
  54    begin
  55       --  No multiprocessor support, always return Not_A_Specific_CPU
  56
  57       return Multiprocessors.Not_A_Specific_CPU;
  58    end Get_Affinity;
  59
  60    ---------------
  61    --  Get_CPU  --
  62    ---------------
  63
  64    function Get_CPU  (Id : Thread_Id) return Multiprocessors.CPU is
  65       pragma Unreferenced (Id);
  66
  67    begin
  68       --  No multiprocessor support, always return the first CPU Id
  69
  70       return Multiprocessors.CPU'First;
  71    end Get_CPU;
  72
  73    -------------------
  74    -- Get_Page_Size --
  75    -------------------
  76
  77    SC_PAGESIZE : constant := 17;
  78    --  C macro to get pagesize value from sysconf
  79
  80    function sysconf (name : int) return long;
  81    pragma Import (C, sysconf, "sysconf");
  82
  83    function Get_Page_Size return int is
  84    begin
  85       return int (sysconf (SC_PAGESIZE));
  86    end Get_Page_Size;
  87
  88    -----------------
  89    -- To_Duration --
  90    -----------------
  91
  92    function To_Duration (TS : timespec) return Duration is
  93    begin
  94       return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
  95    end To_Duration;
  96
  97    ------------------------
  98    -- To_Target_Priority --
  99    ------------------------
 100
 101    function To_Target_Priority
 102      (Prio : System.Any_Priority) return Interfaces.C.int
 103    is
 104    begin
 105       return Interfaces.C.int (Prio);
 106    end To_Target_Priority;
 107
 108    -----------------
 109    -- To_Timespec --
 110    -----------------
 111
 112    function To_Timespec (D : Duration) return timespec is
 113       S : time_t;
 114       F : Duration;
 115
 116    begin
 117       S := time_t (Long_Long_Integer (D));
 118       F := D - Duration (S);
 119
 120       --  If F is negative due to a round-up, adjust for positive F value
 121
 122       if F < 0.0 then
 123          S := S - 1;
 124          F := F + 1.0;
 125       end if;
 126
 127       return timespec'(tv_sec => S,
 128                        tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
 129    end To_Timespec;
 130
 131    -------------
 132    -- sigwait --
 133    -------------
 134
 135    function sigwait
 136      (set :  access sigset_t;
 137       sig :  access Signal)
 138       return int
 139    is
 140       function sigwaitinfo
 141         (set   : access sigset_t;
 142          info  : System.Address) return Signal;
 143       pragma Import (C, sigwaitinfo, "sigwaitinfo");
 144
 145    begin
 146       sig.all := sigwaitinfo (set, Null_Address);
 147
 148       if sig.all = -1 then
 149          return errno;
 150       end if;
 151
 152       return 0;
 153    end sigwait;
 154
 155    --------------------
 156    -- Get_Stack_Base --
 157    --------------------
 158
 159    function Get_Stack_Base (thread : pthread_t) return Address is
 160       pragma Warnings (Off, thread);
 161    begin
 162       return Null_Address;
 163    end Get_Stack_Base;
 164
 165    ------------------
 166    -- pthread_init --
 167    ------------------
 168
 169    procedure pthread_init is
 170    begin
 171       null;
 172    end pthread_init;
 173
 174 end System.OS_Interface;