From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/s-osinte-lynxos-3.adb | 575 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 575 insertions(+) create mode 100644 gcc/ada/s-osinte-lynxos-3.adb (limited to 'gcc/ada/s-osinte-lynxos-3.adb') diff --git a/gcc/ada/s-osinte-lynxos-3.adb b/gcc/ada/s-osinte-lynxos-3.adb new file mode 100644 index 000000000..0a4a3deb4 --- /dev/null +++ b/gcc/ada/s-osinte-lynxos-3.adb @@ -0,0 +1,575 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT 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) 1999-2009, Free Software Foundation, Inc. -- +-- -- +-- GNARL 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 -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a LynxOS (Native) version of this package + +pragma Polling (Off); +-- Turn off polling, we do not want ATC polling to take place during +-- tasking operations. It causes infinite loops and other problems. + +package body System.OS_Interface is + + use Interfaces.C; + + ------------------- + -- clock_gettime -- + ------------------- + + function clock_gettime + (clock_id : clockid_t; + tp : access timespec) + return int + is + function clock_gettime_base + (clock_id : clockid_t; + tp : access timespec) + return int; + pragma Import (C, clock_gettime_base, "clock_gettime"); + + begin + if clock_gettime_base (clock_id, tp) /= 0 then + return errno; + end if; + + return 0; + end clock_gettime; + + ----------------- + -- 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 a 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; + + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- + + function sigwait + (set : access sigset_t; + sig : access Signal) + return int + is + function sigwait_base + (set : access sigset_t; + value : System.Address) + return Signal; + pragma Import (C, sigwait_base, "sigwait"); + + begin + sig.all := sigwait_base (set, Null_Address); + + if sig.all = -1 then + return errno; + end if; + + return 0; + end sigwait; + + -------------------------- + -- POSIX.1c Section 11 -- + -------------------------- + + -- For all the following functions, LynxOS threads has the POSIX Draft 4 + -- behavior; it sets errno but the standard Posix requires it to be + -- returned. + + function pthread_mutexattr_init + (attr : access pthread_mutexattr_t) + return int + is + function pthread_mutexattr_create + (attr : access pthread_mutexattr_t) + return int; + pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create"); + + begin + if pthread_mutexattr_create (attr) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutexattr_init; + + function pthread_mutexattr_destroy + (attr : access pthread_mutexattr_t) + return int + is + function pthread_mutexattr_delete + (attr : access pthread_mutexattr_t) + return int; + pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete"); + + begin + if pthread_mutexattr_delete (attr) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutexattr_destroy; + + function pthread_mutex_init + (mutex : access pthread_mutex_t; + attr : access pthread_mutexattr_t) + return int + is + function pthread_mutex_init_base + (mutex : access pthread_mutex_t; + attr : pthread_mutexattr_t) + return int; + pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init"); + + begin + if pthread_mutex_init_base (mutex, attr.all) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutex_init; + + function pthread_mutex_destroy + (mutex : access pthread_mutex_t) + return int + is + function pthread_mutex_destroy_base + (mutex : access pthread_mutex_t) + return int; + pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy"); + + begin + if pthread_mutex_destroy_base (mutex) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutex_destroy; + + function pthread_mutex_lock + (mutex : access pthread_mutex_t) + return int + is + function pthread_mutex_lock_base + (mutex : access pthread_mutex_t) + return int; + pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock"); + + begin + if pthread_mutex_lock_base (mutex) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutex_lock; + + function pthread_mutex_unlock + (mutex : access pthread_mutex_t) + return int + is + function pthread_mutex_unlock_base + (mutex : access pthread_mutex_t) + return int; + pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock"); + + begin + if pthread_mutex_unlock_base (mutex) /= 0 then + return errno; + end if; + + return 0; + end pthread_mutex_unlock; + + function pthread_condattr_init + (attr : access pthread_condattr_t) + return int + is + function pthread_condattr_create + (attr : access pthread_condattr_t) + return int; + pragma Import (C, pthread_condattr_create, "pthread_condattr_create"); + + begin + if pthread_condattr_create (attr) /= 0 then + return errno; + end if; + + return 0; + end pthread_condattr_init; + + function pthread_condattr_destroy + (attr : access pthread_condattr_t) + return int + is + function pthread_condattr_delete + (attr : access pthread_condattr_t) + return int; + pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete"); + + begin + if pthread_condattr_delete (attr) /= 0 then + return errno; + end if; + + return 0; + end pthread_condattr_destroy; + + function pthread_cond_init + (cond : access pthread_cond_t; + attr : access pthread_condattr_t) + return int + is + function pthread_cond_init_base + (cond : access pthread_cond_t; + attr : pthread_condattr_t) + return int; + pragma Import (C, pthread_cond_init_base, "pthread_cond_init"); + + begin + if pthread_cond_init_base (cond, attr.all) /= 0 then + return errno; + end if; + + return 0; + end pthread_cond_init; + + function pthread_cond_destroy + (cond : access pthread_cond_t) + return int + is + function pthread_cond_destroy_base + (cond : access pthread_cond_t) + return int; + pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy"); + + begin + if pthread_cond_destroy_base (cond) /= 0 then + return errno; + end if; + + return 0; + end pthread_cond_destroy; + + function pthread_cond_signal + (cond : access pthread_cond_t) + return int + is + function pthread_cond_signal_base + (cond : access pthread_cond_t) + return int; + pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal"); + + begin + if pthread_cond_signal_base (cond) /= 0 then + return errno; + end if; + + return 0; + end pthread_cond_signal; + + function pthread_cond_wait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t) + return int + is + function pthread_cond_wait_base + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t) + return int; + pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait"); + + begin + if pthread_cond_wait_base (cond, mutex) /= 0 then + return errno; + end if; + + return 0; + end pthread_cond_wait; + + function pthread_cond_timedwait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t; + reltime : access timespec) return int + is + function pthread_cond_timedwait_base + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t; + reltime : access timespec) return int; + pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait"); + + begin + if pthread_cond_timedwait_base (cond, mutex, reltime) /= 0 then + if errno = EAGAIN then + return ETIMEDOUT; + end if; + + return errno; + end if; + + return 0; + end pthread_cond_timedwait; + + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- + + function pthread_setschedparam + (thread : pthread_t; + policy : int; + param : access struct_sched_param) + return int + is + function pthread_setscheduler + (thread : pthread_t; + policy : int; + prio : int) + return int; + pragma Import (C, pthread_setscheduler, "pthread_setscheduler"); + + begin + if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then + return errno; + end if; + + return 0; + end pthread_setschedparam; + + function pthread_mutexattr_setprotocol + (attr : access pthread_mutexattr_t; + protocol : int) + return int + is + pragma Unreferenced (attr, protocol); + begin + return 0; + end pthread_mutexattr_setprotocol; + + function pthread_mutexattr_setprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : int) + return int + is + pragma Unreferenced (attr, prioceiling); + begin + return 0; + end pthread_mutexattr_setprioceiling; + + function pthread_attr_setscope + (attr : access pthread_attr_t; + contentionscope : int) + return int + is + pragma Unreferenced (attr, contentionscope); + begin + return 0; + end pthread_attr_setscope; + + function sched_yield return int is + procedure pthread_yield; + pragma Import (C, pthread_yield, "pthread_yield"); + + begin + pthread_yield; + return 0; + end sched_yield; + + ----------------------------- + -- P1003.1c - Section 16 -- + ----------------------------- + + function pthread_attr_setdetachstate + (attr : access pthread_attr_t; + detachstate : int) + return int + is + pragma Unreferenced (attr, detachstate); + begin + return 0; + end pthread_attr_setdetachstate; + + function pthread_create + (thread : access pthread_t; + attributes : access pthread_attr_t; + start_routine : Thread_Body; + arg : System.Address) + return int + is + -- The LynxOS pthread_create doesn't seems to work. + -- Workaround : We're using st_new instead. + -- + -- function pthread_create_base + -- (thread : access pthread_t; + -- attributes : pthread_attr_t; + -- start_routine : Thread_Body; + -- arg : System.Address) + -- return int; + -- pragma Import (C, pthread_create_base, "pthread_create"); + + St : aliased st_t := attributes.st; + + function st_new + (start_routine : Thread_Body; + arg : System.Address; + attributes : access st_t; + thread : access pthread_t) + return int; + pragma Import (C, st_new, "st_new"); + + begin + -- Following code would be used if above commented function worked + + -- if pthread_create_base + -- (thread, attributes.all, start_routine, arg) /= 0 then + + if st_new (start_routine, arg, St'Access, thread) /= 0 then + return errno; + end if; + + return 0; + end pthread_create; + + function pthread_detach (thread : pthread_t) return int is + aliased_thread : aliased pthread_t := thread; + + function pthread_detach_base (thread : access pthread_t) return int; + pragma Import (C, pthread_detach_base, "pthread_detach"); + + begin + if pthread_detach_base (aliased_thread'Access) /= 0 then + return errno; + end if; + + return 0; + end pthread_detach; + + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- + + function pthread_setspecific + (key : pthread_key_t; + value : System.Address) + return int + is + function pthread_setspecific_base + (key : pthread_key_t; + value : System.Address) + return int; + pragma Import (C, pthread_setspecific_base, "pthread_setspecific"); + + begin + if pthread_setspecific_base (key, value) /= 0 then + return errno; + end if; + + return 0; + end pthread_setspecific; + + function pthread_getspecific (key : pthread_key_t) return System.Address is + procedure pthread_getspecific_base + (key : pthread_key_t; + value : access System.Address); + pragma Import (C, pthread_getspecific_base, "pthread_getspecific"); + + value : aliased System.Address := System.Null_Address; + + begin + pthread_getspecific_base (key, value'Unchecked_Access); + return value; + end pthread_getspecific; + + function Get_Stack_Base (thread : pthread_t) return Address is + pragma Warnings (Off, thread); + + begin + return Null_Address; + end Get_Stack_Base; + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) + return int + is + function pthread_keycreate + (key : access pthread_key_t; + destructor : destructor_pointer) + return int; + pragma Import (C, pthread_keycreate, "pthread_keycreate"); + + begin + if pthread_keycreate (key, destructor) /= 0 then + return errno; + end if; + + return 0; + end pthread_key_create; + + procedure pthread_init is + begin + null; + end pthread_init; + +end System.OS_Interface; -- cgit v1.2.3