| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
| -- -- |
| -- S Y S T E M . O S _ I N T E R F A C E -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1991-2017, Florida State University -- |
| -- Copyright (C) 1995-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNARL was developed by the GNARL team at Florida State University. It is -- |
| -- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- |
| -- State University (http://www.gnat.com). -- |
| -- -- |
| -- The GNARL files that were developed for RTEMS are maintained by On-Line -- |
| -- Applications Research Corporation (http://www.oarcorp.com) in coopera- -- |
| -- tion with Ada Core Technologies Inc. and Florida State University. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- This is the RTEMS version of this package |
| |
| -- This package encapsulates all direct interfaces to OS services |
| -- that are needed by children of System. |
| |
| with Interfaces.C; use Interfaces.C; |
| |
| package body System.OS_Interface is |
| |
| --------------- |
| -- RTEMS API -- |
| --------------- |
| |
| type RTEMS_Attributes is new unsigned; |
| |
| RTEMS_SIMPLE_BINARY_SEMAPHORE : constant := 16#00000020#; |
| RTEMS_FIFO : constant := 16#00000000#; |
| |
| type RTEMS_Interval is new unsigned; |
| |
| RTEMS_NO_TIMEOUT : constant := 0; |
| |
| type RTEMS_Options is new unsigned; |
| |
| RTEMS_WAIT : constant := 16#00000000#; |
| RTEMS_INTERRUPT_UNIQUE : constant := 16#00000001#; |
| |
| type RTEMS_Name is new unsigned; |
| |
| function RTEMS_Build_Name (C1, C2, C3, C4 : Character) return RTEMS_Name |
| with Import, External_Name => "rtems_build_name", Convention => C; |
| |
| function RTEMS_Semaphore_Create |
| (Name : RTEMS_Name; |
| Count : unsigned; |
| Attributes : RTEMS_Attributes; |
| Priority_Ceiling : unsigned; |
| Semaphore : out Binary_Semaphore_Id) return int |
| with Import, External_Name => "rtems_semaphore_create", Convention => C; |
| |
| function RTEMS_Semaphore_Delete (Semaphore : Binary_Semaphore_Id) return int |
| with Import, External_Name => "rtems_semaphore_delete", Convention => C; |
| |
| function RTEMS_Semaphore_Flush (Semaphore : Binary_Semaphore_Id) |
| return int |
| with Import, External_Name => "rtems_semaphore_flush", Convention => C; |
| |
| function RTEMS_Semaphore_Obtain |
| (Semaphore : Binary_Semaphore_Id; |
| Options : RTEMS_Options; |
| Timeout : RTEMS_Interval) return int |
| with Import, External_Name => "rtems_semaphore_obtain", Convention => C; |
| |
| function RTEMS_Semaphore_Release (Semaphore : Binary_Semaphore_Id) |
| return int |
| with Import, External_Name => "rtems_semaphore_release", Convention => C; |
| |
| ----------------- |
| -- To_Duration -- |
| ----------------- |
| |
| function To_Duration (TS : timespec) return Duration is |
| begin |
| return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; |
| end To_Duration; |
| |
| ------------------------ |
| -- To_Target_Priority -- |
| ------------------------ |
| |
| function To_Target_Priority |
| (Prio : System.Any_Priority) return Interfaces.C.int |
| is |
| begin |
| return Interfaces.C.int (Prio); |
| end To_Target_Priority; |
| |
| ----------------- |
| -- To_Timespec -- |
| ----------------- |
| |
| function To_Timespec (D : Duration) return timespec is |
| S : time_t; |
| F : Duration; |
| begin |
| S := time_t (Long_Long_Integer (D)); |
| F := D - Duration (S); |
| |
| -- If F has negative value due to round-up, adjust for positive F value |
| |
| if F < 0.0 then |
| S := S - 1; |
| F := F + 1.0; |
| end if; |
| return timespec'(tv_sec => S, |
| tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); |
| end To_Timespec; |
| |
| ----------------------------- |
| -- Binary_Semaphore_Create -- |
| ----------------------------- |
| |
| function Binary_Semaphore_Create return Binary_Semaphore_Id is |
| Semaphore : Binary_Semaphore_Id; |
| Status : int; |
| begin |
| Status := |
| RTEMS_Semaphore_Create |
| (Name => RTEMS_Build_Name ('G', 'N', 'A', 'T'), |
| Count => 0, |
| Attributes => RTEMS_SIMPLE_BINARY_SEMAPHORE or RTEMS_FIFO, |
| Priority_Ceiling => 0, |
| Semaphore => Semaphore); |
| |
| pragma Assert (Status = 0); |
| |
| return Semaphore; |
| end Binary_Semaphore_Create; |
| |
| ----------------------------- |
| -- Binary_Semaphore_Delete -- |
| ----------------------------- |
| |
| function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) |
| return int is |
| begin |
| return RTEMS_Semaphore_Delete (ID); |
| end Binary_Semaphore_Delete; |
| |
| ----------------------------- |
| -- Binary_Semaphore_Obtain -- |
| ----------------------------- |
| |
| function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) |
| return int is |
| begin |
| return RTEMS_Semaphore_Obtain (ID, RTEMS_WAIT, RTEMS_NO_TIMEOUT); |
| end Binary_Semaphore_Obtain; |
| |
| ------------------------------ |
| -- Binary_Semaphore_Release -- |
| ------------------------------ |
| |
| function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) |
| return int is |
| begin |
| return RTEMS_Semaphore_Release (ID); |
| end Binary_Semaphore_Release; |
| |
| ---------------------------- |
| -- Binary_Semaphore_Flush -- |
| ---------------------------- |
| |
| function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is |
| begin |
| return RTEMS_Semaphore_Flush (ID); |
| end Binary_Semaphore_Flush; |
| |
| ----------------------- |
| -- Interrupt_Connect -- |
| ----------------------- |
| |
| function Interrupt_Connect |
| (Vector : Interrupt_Vector; |
| Handler : Interrupt_Handler; |
| Parameter : System.Address := System.Null_Address) return int |
| is |
| function RTEMS_Interrupt_Handler_Install |
| (Vector : Interrupt_Vector; |
| Info : char_array; |
| Options : RTEMS_Options; |
| Handler : Interrupt_Handler; |
| Parameter : System.Address) return int |
| with Import, |
| External_Name => "rtems_interrupt_handler_install", |
| Convention => C; |
| |
| Info_String : constant char_array := To_C ("GNAT Interrupt Handler"); |
| -- Handler name that is registered with RTEMS |
| begin |
| return |
| RTEMS_Interrupt_Handler_Install |
| (Vector => Vector, |
| Info => Info_String, |
| Options => RTEMS_INTERRUPT_UNIQUE, |
| Handler => Handler, |
| Parameter => Parameter); |
| end Interrupt_Connect; |
| |
| -------------------------------- |
| -- Interrupt_Number_To_Vector -- |
| -------------------------------- |
| |
| function Interrupt_Number_To_Vector (intNum : int) |
| return Interrupt_Vector |
| is |
| begin |
| return Interrupt_Vector (intNum); |
| end Interrupt_Number_To_Vector; |
| |
| ------------------ |
| -- pthread_init -- |
| ------------------ |
| |
| procedure pthread_init is |
| begin |
| null; |
| end pthread_init; |
| |
| -------------------- |
| -- Get_Stack_Base -- |
| -------------------- |
| |
| function Get_Stack_Base (thread : pthread_t) return Address is |
| pragma Warnings (Off, thread); |
| |
| begin |
| return Null_Address; |
| end Get_Stack_Base; |
| |
| ----------------- |
| -- sigaltstack -- |
| ----------------- |
| |
| function sigaltstack |
| (ss : not null access stack_t; |
| oss : access stack_t) return int is |
| pragma Unreferenced (ss); |
| pragma Unreferenced (oss); |
| begin |
| return 0; |
| end sigaltstack; |
| |
| ----------------------------------- |
| -- pthread_rwlockattr_setkind_np -- |
| ----------------------------------- |
| |
| function pthread_rwlockattr_setkind_np |
| (attr : access pthread_rwlockattr_t; |
| pref : int) return int is |
| pragma Unreferenced (attr); |
| pragma Unreferenced (pref); |
| begin |
| return 0; |
| end pthread_rwlockattr_setkind_np; |
| |
| end System.OS_Interface; |
