File : s-osinte-pikeos.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) 2009-2016, AdaCore                     --
  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. 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.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  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 Ravenscar version of this package for PikeOS
  33 
  34 --  This package encapsulates all direct interfaces to OS services that are
  35 --  needed by the tasking run-time (libgnarl).
  36 
  37 package body System.OS_Interface is
  38 
  39    --  Sycalls defined in p4.h
  40 
  41    procedure p4_get_time_syscall (Res : Address);
  42    pragma Import (C, p4_get_time_syscall);
  43 
  44    function p4_sleep (Timeout : P4_timeout_t) return P4_e_t;
  45    pragma Import (C, p4_sleep);
  46 
  47    procedure p4_thread_yield;
  48    pragma Import (C, p4_thread_yield);
  49 
  50    function p4_my_uid return P4_uid_t;
  51    pragma Import (C, p4_my_uid);
  52 
  53    function p4_thread_stop (Tnum : P4_thr_t) return P4_e_t;
  54    pragma Import (C, p4_thread_stop);
  55 
  56    function p4_thread_resume (Tnum : P4_thr_t) return P4_e_t;
  57    pragma Import (C, p4_thread_resume);
  58 
  59    function p4_thread_ex_sched
  60      (Tnum     : P4_thr_t;
  61       Old_Prio : Address;
  62       Old_Tp   : Address;
  63       New_Prio : P4_prio_t;
  64       New_Tp   : P4_uint32_t)
  65      return P4_e_t;
  66    pragma Import (C, p4_thread_ex_sched);
  67 
  68    function p4_fast_set_prio (New_Prio : P4_prio_t) return P4_prio_t;
  69    pragma Import (C, p4_fast_set_prio);
  70 
  71    function p4_thread_get_attr (Tnum : P4_thr_t; Attr : Address) return P4_e_t;
  72    pragma Import (C, p4_thread_get_attr);
  73 
  74    function p4_my_thread return P4_thr_t;
  75    --  This function is documented as pseudo-syscall. The implementation is
  76    --  only provided by a C static inline function.
  77 
  78    function p4_thread_get_priority (Tnum : P4_thr_t; Prio : Address)
  79                                    return P4_e_t;
  80    --  This function is documented as pseudo-syscall. The implementation is
  81    --  only provided by a C static inline function.
  82 
  83    Max_Thread_Num : constant P4_thr_t := 512;
  84    --  Maximum number of threads that can be created
  85 
  86    type Thread_Id_Array is array (P4_thr_t range 0 .. Max_Thread_Num) of
  87      Thread_Id;
  88    All_Threads : Thread_Id_Array := (others => null);
  89    --  Array of tasks.  Used to implement Get_ATCB.
  90    --  ??? This duplicates system.tasking.debug.known_tasks.
  91 
  92    Next_Thread : P4_thr_t := 0;
  93    --  Number of the next task to be created
  94 
  95    ------------------------------
  96    --  p4_thread_get_priority  --
  97    ------------------------------
  98 
  99    function p4_thread_get_priority (Tnum : P4_thr_t; Prio : Address)
 100                                    return P4_e_t is
 101    begin
 102       return p4_thread_ex_sched (Tnum, Prio, Null_Address,
 103                                  P4_PRIO_KEEP, P4_TIMEPART_KEEP);
 104    end p4_thread_get_priority;
 105 
 106    -------------------
 107    --  p4_my_thread --
 108    -------------------
 109 
 110    function p4_my_thread return P4_thr_t is
 111       Uid : constant P4_uid_t := p4_my_uid;
 112 
 113    begin
 114       --  The lower 9 bits
 115 
 116       return Uid mod 512;
 117    end p4_my_thread;
 118 
 119    ----------------------
 120    --  Attach_Handler  --
 121    ----------------------
 122 
 123    procedure Attach_Handler
 124      (Handler : Interrupt_Handler;
 125       Id      : Interrupt_ID)
 126    is
 127    begin
 128       --  Not yet supported
 129 
 130       raise Program_Error;
 131    end Attach_Handler;
 132 
 133    ------------------
 134    --  Current_CPU --
 135    ------------------
 136 
 137    function Current_CPU return Multiprocessors.CPU is
 138    begin
 139       --  No multiprocessor support, always return the first CPU Id
 140 
 141       return Multiprocessors.CPU'First;
 142    end Current_CPU;
 143 
 144    -------------------------
 145    --  Current_Interrupt  --
 146    -------------------------
 147 
 148    function Current_Interrupt return Interrupt_ID is
 149    begin
 150       --  Not yet supported
 151 
 152       return No_Interrupt;
 153    end Current_Interrupt;
 154 
 155    -------------
 156    --  Clock  --
 157    -------------
 158 
 159    function Clock return Time is
 160       Res : P4_time_t;
 161    begin
 162       p4_get_time_syscall (Res'Address);
 163       return Res;
 164    end Clock;
 165 
 166    -------------------
 167    --  Delay_Until  --
 168    -------------------
 169 
 170    procedure Delay_Until (T : Time) is
 171       Res : P4_e_t;
 172 
 173    begin
 174       Res := p4_sleep (T + P4_TIMEOUT_ABSOLUTE);
 175 
 176       if Res = P4_E_BADTIMEOUT then
 177 
 178          --  ARM D.2.3 7/2 requires a yield, even if delay is in the past or 0
 179 
 180          p4_thread_yield;
 181       end if;
 182    end Delay_Until;
 183 
 184    -----------------
 185    --  Initialize --
 186    -----------------
 187 
 188    procedure Initialize
 189      (Environment_Thread : Thread_Id;
 190       Main_Priority      : System.Any_Priority) is
 191       Prev : P4_prio_t;
 192       pragma Unreferenced (Prev);
 193 
 194    begin
 195       --  The environment thread is the first thread
 196 
 197       pragma Assert (p4_my_thread = 0);
 198       pragma Assert (Next_Thread = 0);
 199 
 200       Environment_Thread.Num := 0;
 201       Environment_Thread.Base_Priority := Main_Priority;
 202       All_Threads (0) := Environment_Thread;
 203 
 204       Prev := p4_fast_set_prio (P4_prio_t (Main_Priority));
 205 
 206       --  Find the next available thread number. It should be 1 but the
 207       --  debugger stub (if enabled) creates two threads.
 208 
 209       loop
 210          Next_Thread := Next_Thread + 1;
 211          exit when p4_thread_get_attr (Next_Thread, Null_Address) = P4_E_STATE;
 212       end loop;
 213    end Initialize;
 214 
 215    ---------------------
 216    --  Thread_Create  --
 217    ---------------------
 218 
 219    procedure Thread_Create
 220      (Id            : Thread_Id;
 221       Code          : System.Address;
 222       Arg           : System.Address;
 223       Priority      : System.Any_Priority;
 224       Base_CPU      : System.Multiprocessors.CPU_Range;
 225       Stack_Address : System.Address;
 226       Stack_Size    : System.Parameters.Size_Type)
 227    is
 228       pragma Unreferenced (Base_CPU);
 229 
 230       function Gnat_p4_thread_create
 231         (Num        : P4_thr_t;
 232          Prio       : P4_prio_t;
 233          Code       : Address;
 234          Arg        : Address;
 235          Stack      : Address;
 236          Stack_Size : System.Parameters.Size_Type) return P4_e_t;
 237       pragma Import (C, Gnat_p4_thread_create, "__gnat_p4_thread_create");
 238       --  Wrapper in C to make the implementation easier
 239 
 240       Status : P4_e_t;
 241    begin
 242       --  Be sure there is enough room in the task array
 243       pragma Assert (Next_Thread <= Max_Thread_Num);
 244       pragma Assert (Stack_Address /= Null_Address);
 245 
 246       All_Threads (Next_Thread) := Id;
 247       Id.Num := Next_Thread;
 248 
 249       --  No need to atomically increment Next_Thread as only the environmental
 250       --  task creates tasks, assuming a ravenscar implementation.
 251 
 252       Next_Thread := Next_Thread + 1;
 253 
 254       Status := Gnat_p4_thread_create
 255         (Id.Num, P4_prio_t (Priority), Code, Arg,
 256          Stack_Address, Stack_Size);
 257       pragma Assert (Status = P4_E_OK);
 258    end Thread_Create;
 259 
 260    -------------------
 261    --  Thread_Self  --
 262    -------------------
 263 
 264    function Thread_Self return Thread_Id is
 265       Id : constant P4_thr_t := p4_my_thread;
 266    begin
 267       return All_Threads (Id);
 268    end Thread_Self;
 269 
 270    ----------------
 271    --  Lwp_Self  --
 272    ----------------
 273 
 274    function Lwp_Self return System.Address is
 275    begin
 276       --  This magic value matches the tid returned by gdbstub (as tid 0 is
 277       --  reserved, the tids are shifted).
 278 
 279       return Address (p4_my_thread + 1);
 280    end Lwp_Self;
 281 
 282    ----------------
 283    --  Set_ATCB  --
 284    ----------------
 285 
 286    procedure Set_ATCB (ATCB : System.Address) is
 287       Id : constant P4_thr_t := p4_my_thread;
 288    begin
 289       All_Threads (Id).ATCB := ATCB;
 290    end Set_ATCB;
 291 
 292    ----------------
 293    --  Get_ATCB  --
 294    ----------------
 295 
 296    function Get_ATCB return System.Address is
 297       Id : constant P4_thr_t := p4_my_thread;
 298    begin
 299       return All_Threads (Id).ATCB;
 300    end Get_ATCB;
 301 
 302    --------------------
 303    --  Set_Priority  --
 304    --------------------
 305 
 306    procedure Set_Priority (Priority : System.Any_Priority) is
 307       Prev : P4_prio_t;
 308       pragma Unreferenced (Prev);
 309    begin
 310       Prev := p4_fast_set_prio (P4_prio_t (Priority));
 311    end Set_Priority;
 312 
 313    --------------------
 314    --  Get_Priority  --
 315    --------------------
 316 
 317    function Get_Priority  (Id : Thread_Id) return System.Any_Priority is
 318       Status : P4_e_t;
 319       Prio : P4_prio_t;
 320    begin
 321       Status := p4_thread_get_priority (Id.Num, Prio'Address);
 322       pragma Assert (Status = P4_E_OK);
 323       return Any_Priority (Prio);
 324    end Get_Priority;
 325 
 326    -------------
 327    --  Sleep  --
 328    -------------
 329 
 330    procedure Sleep is
 331       Status : P4_e_t;
 332    begin
 333       Status := p4_thread_stop (p4_my_thread);
 334       pragma Assert (Status = P4_E_OK);
 335    end Sleep;
 336 
 337    --------------
 338    --  Wakeup  --
 339    --------------
 340 
 341    procedure Wakeup (Id : Thread_Id) is
 342       Status : P4_e_t;
 343    begin
 344       Status := p4_thread_resume (Id.Num);
 345       pragma Assert (Status = P4_E_OK);
 346    end Wakeup;
 347 
 348    --------------------
 349    --  Get_Affinity  --
 350    --------------------
 351 
 352    function Get_Affinity (Id : Thread_Id) return Multiprocessors.CPU_Range is
 353       pragma Unreferenced (Id);
 354 
 355    begin
 356       --  No multiprocessor support, always return Not_A_Specific_CPU
 357 
 358       return Multiprocessors.Not_A_Specific_CPU;
 359    end Get_Affinity;
 360 
 361    ---------------
 362    --  Get_CPU  --
 363    ---------------
 364 
 365    function Get_CPU  (Id : Thread_Id) return Multiprocessors.CPU is
 366       pragma Unreferenced (Id);
 367 
 368    begin
 369       --  No multiprocessor support, always return the first CPU Id
 370 
 371       return Multiprocessors.CPU'First;
 372    end Get_CPU;
 373 
 374 end System.OS_Interface;