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) 1991-1994, Florida State University -- 10-- Copyright (C) 1995-2010, AdaCore -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 3, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNARL was developed by the GNARL team at Florida State University. -- 29-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is a GNU/LinuxThreads, Solaris pthread and HP-UX pthread version 34-- of this package. 35 36pragma Polling (Off); 37-- Turn off polling, we do not want ATC polling to take place during 38-- tasking operations. It causes infinite loops and other problems. 39 40-- This package encapsulates all direct interfaces to OS services 41-- that are needed by children of System. 42 43with Interfaces.C; use Interfaces.C; 44package body System.OS_Interface is 45 46 -------------------- 47 -- Get_Stack_Base -- 48 -------------------- 49 50 function Get_Stack_Base (thread : pthread_t) return Address is 51 pragma Warnings (Off, thread); 52 53 begin 54 return Null_Address; 55 end Get_Stack_Base; 56 57 ------------------ 58 -- pthread_init -- 59 ------------------ 60 61 procedure pthread_init is 62 begin 63 null; 64 end pthread_init; 65 66 ----------------- 67 -- To_Duration -- 68 ----------------- 69 70 function To_Duration (TS : timespec) return Duration is 71 begin 72 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 73 end To_Duration; 74 75 ------------------------ 76 -- To_Target_Priority -- 77 ------------------------ 78 79 function To_Target_Priority 80 (Prio : System.Any_Priority) return Interfaces.C.int 81 is 82 begin 83 return Interfaces.C.int (Prio); 84 end To_Target_Priority; 85 86 ----------------- 87 -- To_Timespec -- 88 ----------------- 89 90 function To_Timespec (D : Duration) return timespec is 91 S : time_t; 92 F : Duration; 93 94 begin 95 S := time_t (Long_Long_Integer (D)); 96 F := D - Duration (S); 97 98 -- If F has negative value due to a round-up, adjust for positive F 99 -- value. 100 101 if F < 0.0 then 102 S := S - 1; 103 F := F + 1.0; 104 end if; 105 106 return timespec'(tv_sec => S, 107 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 108 end To_Timespec; 109 110end System.OS_Interface; 111