From: Laurent GUERBY Date: Thu, 27 Jan 2005 11:57:04 +0000 (+0000) Subject: Makefile.in: Rename GNAT RTEMS specific files. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7d921ba4c9870bf955b255ecc9c8213bc6468f1d;p=gcc.git Makefile.in: Rename GNAT RTEMS specific files. 2005-01-27 Laurent GUERBY * Makefile.in: Rename GNAT RTEMS specific files. * 5rtpopsp.adb, 4rintnam.ads, 5rosinte.adb, 5rosinte.ads, 5rparame.adb: Replaced by files below. * s-tpopsp-rtems.adb, a-intman-rtems.ads, s-osinte-rtems.adb, s-osinte-rtems.ads, s-parame-rtems.adb: Replace files above. From-SVN: r94319 --- diff --git a/gcc/ada/4rintnam.ads b/gcc/ada/4rintnam.ads deleted file mode 100644 index 0624dfb15d1..00000000000 --- a/gcc/ada/4rintnam.ads +++ /dev/null @@ -1,116 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- A D A . I N T E R R U P T S . N A M E S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1991-2002 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 2, or (at your option) any later ver- -- --- sion. GNARL 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- --- 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 a RTEMS version of this package --- --- The following signals are reserved by the run time: --- --- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, --- SIGALRM, SIGEMT, SIGKILL --- --- The pragma Unreserve_All_Interrupts affects the following signal(s): --- --- SIGINT: made available for Ada handlers - --- This target-dependent package spec contains names of interrupts --- supported by the local system. - -with System.OS_Interface; --- used for names of interrupts - -package Ada.Interrupts.Names is - - -- Beware that the mapping of names to signals may be - -- many-to-one. There may be aliases. Also, for all - -- signal names that are not supported on the current system - -- the value of the corresponding constant will be zero. - - SIGHUP : constant Interrupt_ID := - System.OS_Interface.SIGHUP; -- hangup - - SIGINT : constant Interrupt_ID := - System.OS_Interface.SIGINT; -- interrupt (rubout) - - SIGQUIT : constant Interrupt_ID := - System.OS_Interface.SIGQUIT; -- quit (ASCD FS) - - SIGILL : constant Interrupt_ID := - System.OS_Interface.SIGILL; -- illegal instruction (not reset) - - SIGTRAP : constant Interrupt_ID := - System.OS_Interface.SIGTRAP; -- trace trap (not reset) - - SIGIOT : constant Interrupt_ID := - System.OS_Interface.SIGIOT; -- IOT instruction - - SIGABRT : constant Interrupt_ID := -- used by abort, - System.OS_Interface.SIGABRT; -- replace SIGIOT in the future - - SIGEMT : constant Interrupt_ID := - System.OS_Interface.SIGEMT; -- EMT instruction - - SIGFPE : constant Interrupt_ID := - System.OS_Interface.SIGFPE; -- floating point exception - - SIGKILL : constant Interrupt_ID := - System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) - - SIGBUS : constant Interrupt_ID := - System.OS_Interface.SIGBUS; -- bus error - - SIGSEGV : constant Interrupt_ID := - System.OS_Interface.SIGSEGV; -- segmentation violation - - SIGSYS : constant Interrupt_ID := - System.OS_Interface.SIGSYS; -- bad argument to system call - - SIGPIPE : constant Interrupt_ID := -- write on a pipe with - System.OS_Interface.SIGPIPE; -- no one to read it - - SIGALRM : constant Interrupt_ID := - System.OS_Interface.SIGALRM; -- alarm clock - - SIGTERM : constant Interrupt_ID := - System.OS_Interface.SIGTERM; -- software termination signal from kill - - SIGUSR1 : constant Interrupt_ID := - System.OS_Interface.SIGUSR1; -- user defined signal 1 - - SIGUSR2 : constant Interrupt_ID := - System.OS_Interface.SIGUSR2; -- user defined signal 2 - -end Ada.Interrupts.Names; diff --git a/gcc/ada/5rosinte.adb b/gcc/ada/5rosinte.adb deleted file mode 100644 index 1bb1ae50a8b..00000000000 --- a/gcc/ada/5rosinte.adb +++ /dev/null @@ -1,121 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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-2002 Florida State University -- --- -- --- 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 2, or (at your option) any later ver- -- --- sion. GNARL 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- 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. - -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. - -with Interfaces.C; use Interfaces.C; -package body System.OS_Interface is - - ----------------- - -- 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_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; - - function To_Duration (TV : struct_timeval) return Duration is - begin - return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; - end To_Duration; - - function To_Timeval (D : Duration) return struct_timeval is - S : int; - F : Duration; - begin - S := int (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 - struct_timeval' - (tv_sec => S, - tv_usec => int (Long_Long_Integer (F * 10#1#E6))); - end To_Timeval; - - procedure pthread_init is - begin - null; - end pthread_init; - - function Get_Stack_Base (thread : pthread_t) return Address is - pragma Warnings (Off, thread); - - begin - return Null_Address; - end Get_Stack_Base; - - function Get_Page_Size return size_t is - begin - return 0; - end Get_Page_Size; - - function Get_Page_Size return Address is - begin - return 0; - end Get_Page_Size; - -end System.OS_Interface; diff --git a/gcc/ada/5rosinte.ads b/gcc/ada/5rosinte.ads deleted file mode 100644 index c15362f70e0..00000000000 --- a/gcc/ada/5rosinte.ads +++ /dev/null @@ -1,531 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . O S _ I N T E R F A C E -- --- -- --- S p e c -- --- -- --- Copyright (C) 1997-2003 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 2, or (at your option) any later ver- -- --- sion. GNARL 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- --- 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 - --- These are guesses based on what I think the GNARL team will want to --- call the rtems configurations. We use CPU-rtems for the rtems --- configurations. - --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. - --- PLEASE DO NOT add any with-clauses to this package --- or remove the pragma Elaborate_Body. --- It is designed to be a bottom-level (leaf) package. - -with Interfaces.C; -package System.OS_Interface is - pragma Preelaborate; - - -- This interface assumes that "unsigned" is a 32-bit entity. This - -- will correspond to RTEMS object ids. - - subtype rtems_id is Interfaces.C.unsigned; - - subtype int is Interfaces.C.int; - subtype short is Interfaces.C.short; - subtype long is Interfaces.C.long; - subtype unsigned is Interfaces.C.unsigned; - subtype unsigned_short is Interfaces.C.unsigned_short; - subtype unsigned_long is Interfaces.C.unsigned_long; - subtype unsigned_char is Interfaces.C.unsigned_char; - subtype plain_char is Interfaces.C.plain_char; - subtype size_t is Interfaces.C.size_t; - - ----------- - -- Errno -- - ----------- - - function errno return int; - pragma Import (C, errno, "__get_errno"); - - EAGAIN : constant := 11; - EINTR : constant := 4; - EINVAL : constant := 22; - ENOMEM : constant := 12; - ETIMEDOUT : constant := 116; - - ------------- - -- Signals -- - ------------- - - Max_Interrupt : constant := 31; - type Signal is new int range 0 .. Max_Interrupt; - - SIGXCPU : constant := 0; -- XCPU - SIGHUP : constant := 1; -- hangup - SIGINT : constant := 2; -- interrupt (rubout) - SIGQUIT : constant := 3; -- quit (ASCD FS) - SIGILL : constant := 4; -- illegal instruction (not reset) - SIGTRAP : constant := 5; -- trace trap (not reset) - SIGIOT : constant := 6; -- IOT instruction - SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future - SIGEMT : constant := 7; -- EMT instruction - SIGFPE : constant := 8; -- floating point exception - SIGKILL : constant := 9; -- kill (cannot be caught or ignored) - SIGBUS : constant := 10; -- bus error - SIGSEGV : constant := 11; -- segmentation violation - SIGSYS : constant := 12; -- bad argument to system call - SIGPIPE : constant := 13; -- write on a pipe with no one to read it - SIGALRM : constant := 14; -- alarm clock - SIGTERM : constant := 15; -- software termination signal from kill - SIGUSR1 : constant := 16; -- user defined signal 1 - SIGUSR2 : constant := 17; -- user defined signal 2 - - SIGADAABORT : constant := SIGABRT; - - type Signal_Set is array (Natural range <>) of Signal; - - Unmasked : constant Signal_Set := (SIGTRAP, SIGALRM, SIGEMT); - Reserved : constant Signal_Set := (1 .. 1 => SIGKILL); - - type sigset_t is private; - - function sigaddset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigaddset, "sigaddset"); - - function sigdelset (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigdelset, "sigdelset"); - - function sigfillset (set : access sigset_t) return int; - pragma Import (C, sigfillset, "sigfillset"); - - function sigismember (set : access sigset_t; sig : Signal) return int; - pragma Import (C, sigismember, "sigismember"); - - function sigemptyset (set : access sigset_t) return int; - pragma Import (C, sigemptyset, "sigemptyset"); - - type struct_sigaction is record - sa_flags : int; - sa_mask : sigset_t; - sa_handler : System.Address; - end record; - pragma Convention (C, struct_sigaction); - type struct_sigaction_ptr is access all struct_sigaction; - - SA_SIGINFO : constant := 16#02#; - - SIG_BLOCK : constant := 1; - SIG_UNBLOCK : constant := 2; - SIG_SETMASK : constant := 3; - - SIG_DFL : constant := 0; - SIG_IGN : constant := 1; - - function sigaction - (sig : Signal; - act : struct_sigaction_ptr; - oact : struct_sigaction_ptr) return int; - pragma Import (C, sigaction, "sigaction"); - - ---------- - -- Time -- - ---------- - - Time_Slice_Supported : constant Boolean := True; - -- Indicates wether time slicing is supported (i.e SCHED_RR is supported) - - type timespec is private; - - type clockid_t is private; - - CLOCK_REALTIME : constant clockid_t; - - function clock_gettime - (clock_id : clockid_t; - tp : access timespec) return int; - pragma Import (C, clock_gettime, "clock_gettime"); - - function To_Duration (TS : timespec) return Duration; - pragma Inline (To_Duration); - - function To_Timespec (D : Duration) return timespec; - pragma Inline (To_Timespec); - - type struct_timeval is private; - - function To_Duration (TV : struct_timeval) return Duration; - pragma Inline (To_Duration); - - function To_Timeval (D : Duration) return struct_timeval; - pragma Inline (To_Timeval); - - ------------------------- - -- Priority Scheduling -- - ------------------------- - - SCHED_FIFO : constant := 1; - SCHED_RR : constant := 2; - SCHED_OTHER : constant := 0; - - ------------- - -- Process -- - ------------- - - type pid_t is private; - - function kill (pid : pid_t; sig : Signal) return int; - pragma Import (C, kill, "kill"); - - function getpid return pid_t; - pragma Import (C, getpid, "getpid"); - - --------- - -- LWP -- - --------- - - function lwp_self return System.Address; - -- lwp_self does not exist on this thread library, revert to pthread_self - -- which is the closest approximation (with getpid). This function is - -- needed to share 7staprop.adb across POSIX-like targets. - pragma Import (C, lwp_self, "pthread_self"); - - ------------- - -- Threads -- - ------------- - - type Thread_Body is access - function (arg : System.Address) return System.Address; - - type pthread_t is private; - subtype Thread_Id is pthread_t; - - type pthread_mutex_t is limited private; - type pthread_cond_t is limited private; - type pthread_attr_t is limited private; - type pthread_mutexattr_t is limited private; - type pthread_condattr_t is limited private; - type pthread_key_t is private; - - No_Key : constant pthread_key_t; - - PTHREAD_CREATE_DETACHED : constant := 0; - - ----------- - -- Stack -- - ----------- - - Stack_Base_Available : constant Boolean := False; - -- Indicates wether the stack base is available on this target. - -- This allows us to share s-osinte.adb between all the FSU/RTEMS - -- run time. - -- Note that this value can only be true if pthread_t has a complete - -- definition that corresponds exactly to the C header files. - - function Get_Stack_Base (thread : pthread_t) return Address; - pragma Inline (Get_Stack_Base); - -- returns the stack base of the specified thread. - -- Only call this function when Stack_Base_Available is True. - - -- These two functions are only needed to share s-taprop.adb with - -- FSU threads. - - function Get_Page_Size return size_t; - function Get_Page_Size return Address; - -- returns the size of a page, or 0 if this is not relevant on this - -- target (which is the case for RTEMS) - - PROT_ON : constant := 0; - PROT_OFF : constant := 0; - - function mprotect (addr : Address; len : size_t; prot : int) return int; - pragma Import (C, mprotect); - - ----------------------------------------- - -- Nonstandard Thread Initialization -- - ----------------------------------------- - - procedure pthread_init; - -- FSU_THREADS requires pthread_init, which is nonstandard - -- and this should be invoked during the elaboration of s-taprop.adb - -- - -- RTEMS does not require this so we provide an empty Ada body. - - ------------------------- - -- POSIX.1c Section 3 -- - ------------------------- - - function sigwait - (set : access sigset_t; - sig : access Signal) return int; - pragma Import (C, sigwait, "sigwait"); - - function pthread_kill - (thread : pthread_t; - sig : Signal) return int; - pragma Import (C, pthread_kill, "pthread_kill"); - - type sigset_t_ptr is access all sigset_t; - - function pthread_sigmask - (how : int; - set : sigset_t_ptr; - oset : sigset_t_ptr) return int; - pragma Import (C, pthread_sigmask, "pthread_sigmask"); - - ---------------------------- - -- POSIX.1c Section 11 -- - ---------------------------- - - function pthread_mutexattr_init - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init"); - - function pthread_mutexattr_destroy - (attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy"); - - function pthread_mutex_init - (mutex : access pthread_mutex_t; - attr : access pthread_mutexattr_t) return int; - pragma Import (C, pthread_mutex_init, "pthread_mutex_init"); - - function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy"); - - function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock"); - - function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock"); - - function pthread_condattr_init - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_init, "pthread_condattr_init"); - - function pthread_condattr_destroy - (attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy"); - - function pthread_cond_init - (cond : access pthread_cond_t; - attr : access pthread_condattr_t) return int; - pragma Import (C, pthread_cond_init, "pthread_cond_init"); - - function pthread_cond_destroy (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy"); - - function pthread_cond_signal (cond : access pthread_cond_t) return int; - pragma Import (C, pthread_cond_signal, "pthread_cond_signal"); - - function pthread_cond_wait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t) return int; - pragma Import (C, pthread_cond_wait, "pthread_cond_wait"); - - function pthread_cond_timedwait - (cond : access pthread_cond_t; - mutex : access pthread_mutex_t; - abstime : access timespec) return int; - pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); - - Relative_Timed_Wait : constant Boolean := False; - -- pthread_cond_timedwait requires an absolute delay time - - -------------------------- - -- POSIX.1c Section 13 -- - -------------------------- - - PTHREAD_PRIO_NONE : constant := 0; - PTHREAD_PRIO_PROTECT : constant := 2; - PTHREAD_PRIO_INHERIT : constant := 1; - - function pthread_mutexattr_setprotocol - (attr : access pthread_mutexattr_t; - protocol : int) return int; - pragma Import (C, pthread_mutexattr_setprotocol); - - function pthread_mutexattr_setprioceiling - (attr : access pthread_mutexattr_t; - prioceiling : int) return int; - pragma Import - (C, pthread_mutexattr_setprioceiling, - "pthread_mutexattr_setprioceiling"); - - type struct_sched_param is record - sched_priority : int; - ss_low_priority : timespec; - ss_replenish_period : timespec; - ss_initial_budget : timespec; - end record; - pragma Convention (C, struct_sched_param); - - function pthread_setschedparam - (thread : pthread_t; - policy : int; - param : access struct_sched_param) return int; - pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); - - function pthread_attr_setscope - (attr : access pthread_attr_t; - contentionscope : int) return int; - pragma Import (C, pthread_attr_setscope, "pthread_attr_setscope"); - - function pthread_attr_setinheritsched - (attr : access pthread_attr_t; - inheritsched : int) return int; - pragma Import (C, pthread_attr_setinheritsched); - - function pthread_attr_setschedpolicy - (attr : access pthread_attr_t; - policy : int) return int; - pragma Import (C, pthread_attr_setschedpolicy); - - function pthread_attr_setschedparam - (attr : access pthread_attr_t; - sched_param : int) return int; - pragma Import (C, pthread_attr_setschedparam); - - function sched_yield return int; - pragma Import (C, sched_yield, "sched_yield"); - - --------------------------- - -- P1003.1c - Section 16 -- - --------------------------- - - function pthread_attr_init (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_init, "pthread_attr_init"); - - function pthread_attr_destroy - (attributes : access pthread_attr_t) return int; - pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy"); - - function pthread_attr_setdetachstate - (attr : access pthread_attr_t; - detachstate : int) return int; - pragma Import (C, pthread_attr_setdetachstate); - - function pthread_attr_setstacksize - (attr : access pthread_attr_t; - stacksize : size_t) return int; - pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize"); - - function pthread_create - (thread : access pthread_t; - attributes : access pthread_attr_t; - start_routine : Thread_Body; - arg : System.Address) return int; - pragma Import (C, pthread_create, "pthread_create"); - - procedure pthread_exit (status : System.Address); - pragma Import (C, pthread_exit, "pthread_exit"); - - function pthread_self return pthread_t; - pragma Import (C, pthread_self, "pthread_self"); - - -------------------------- - -- POSIX.1c Section 17 -- - -------------------------- - - function pthread_setspecific - (key : pthread_key_t; - value : System.Address) return int; - pragma Import (C, pthread_setspecific, "pthread_setspecific"); - - function pthread_getspecific (key : pthread_key_t) return System.Address; - pragma Import (C, pthread_getspecific, "pthread_getspecific"); - - type destructor_pointer is access procedure (arg : System.Address); - - function pthread_key_create - (key : access pthread_key_t; - destructor : destructor_pointer) return int; - pragma Import (C, pthread_key_create, "pthread_key_create"); - -private - - type sigset_t is new int; - - type pid_t is new int; - - type time_t is new long; - - type timespec is record - tv_sec : time_t; - tv_nsec : long; - end record; - pragma Convention (C, timespec); - - type clockid_t is new rtems_id; - CLOCK_REALTIME : constant clockid_t := 1; - - type struct_timeval is record - tv_sec : int; - tv_usec : int; - end record; - pragma Convention (C, struct_timeval); - - type pthread_attr_t is record - is_initialized : int; - stackaddr : System.Address; - stacksize : int; - contentionscope : int; - inheritsched : int; - schedpolicy : int; - schedparam : struct_sched_param; - cputime_clocked_allowed : int; - deatchstate : int; - end record; - pragma Convention (C, pthread_attr_t); - - type pthread_condattr_t is record - flags : int; - end record; - pragma Convention (C, pthread_condattr_t); - - type pthread_mutexattr_t is record - is_initialized : int; - process_shared : int; - prio_ceiling : int; - protocol : int; - recursive : int; - end record; - pragma Convention (C, pthread_mutexattr_t); - - type pthread_t is new rtems_id; - - type pthread_mutex_t is new rtems_id; - - type pthread_cond_t is new rtems_id; - - type pthread_key_t is new rtems_id; - - No_Key : constant pthread_key_t := 0; - -end System.OS_Interface; diff --git a/gcc/ada/5rparame.adb b/gcc/ada/5rparame.adb deleted file mode 100644 index b6e15c776a8..00000000000 --- a/gcc/ada/5rparame.adb +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S Y S T E M . P A R A M E T E R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1997-1998 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 2, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the RTEMS specific version - -with Interfaces.C; - -package body System.Parameters is - - function ada_pthread_minimum_stack_size return Interfaces.C.size_t; - pragma Import (C, ada_pthread_minimum_stack_size, - "_ada_pthread_minimum_stack_size"); - - ------------------------ - -- Default_Stack_Size -- - ------------------------ - - function Default_Stack_Size return Size_Type is - begin - return Size_Type (ada_pthread_minimum_stack_size); - end Default_Stack_Size; - - ------------------------ - -- Minimum_Stack_Size -- - ------------------------ - - function Minimum_Stack_Size return Size_Type is - - begin - return Size_Type (ada_pthread_minimum_stack_size); - end Minimum_Stack_Size; - - ------------------------- - -- Adjust_Storage_Size -- - ------------------------- - - function Adjust_Storage_Size (Size : Size_Type) return Size_Type is - begin - if Size = Unspecified_Size then - return Default_Stack_Size; - - elsif Size < Minimum_Stack_Size then - return Minimum_Stack_Size; - - else - return Size; - end if; - end Adjust_Storage_Size; - -end System.Parameters; diff --git a/gcc/ada/5rtpopsp.adb b/gcc/ada/5rtpopsp.adb deleted file mode 100644 index 6c83352cd62..00000000000 --- a/gcc/ada/5rtpopsp.adb +++ /dev/null @@ -1,115 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S . -- --- S P E C I F I C -- --- -- --- B o d y -- --- -- --- $Revision: 1.2 $ --- -- --- Copyright (C) 1991-2003, Florida State University -- --- -- --- 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 2, or (at your option) any later ver- -- --- sion. GNARL 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNARL; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- 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). -- --- -- ------------------------------------------------------------------------------- - --- This is a RTEMS version of this package which uses a special --- variable for Ada self which is contexted switch implicitly by RTEMS. --- --- This is the same as the POSIX version except that an RTEMS variable --- is used instead of a POSIX key. - -separate (System.Task_Primitives.Operations) -package body Specific is - - -- The following gives the Ada run-time direct access to a variable - -- context switched by RTEMS at the lowest level. - - RTEMS_Ada_Self : System.Address; - pragma Import (C, RTEMS_Ada_Self, "rtems_ada_self"); - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize (Environment_Task : Task_Id) is - pragma Warnings (Off, Environment_Task); - - begin - ATCB_Key := No_Key; - RTEMS_Ada_Self := To_Address (Environment_Task); - end Initialize; - - ------------------- - -- Is_Valid_Task -- - ------------------- - - function Is_Valid_Task return Boolean is - begin - return RTEMS_Ada_Self /= System.Null_Address; - end Is_Valid_Task; - - --------- - -- Set -- - --------- - - procedure Set (Self_Id : Task_Id) is - begin - RTEMS_Ada_Self := To_Address (Self_Id); - end Set; - - ---------- - -- Self -- - ---------- - - -- To make Ada tasks and C threads interoperate better, we have added some - -- functionality to Self. Suppose a C main program (with threads) calls an - -- Ada procedure and the Ada procedure calls the tasking runtime system. - -- Eventually, a call will be made to self. Since the call is not coming - -- from an Ada task, there will be no corresponding ATCB. - - -- What we do in Self is to catch references that do not come from - -- recognized Ada tasks, and create an ATCB for the calling thread. - - -- The new ATCB will be "detached" from the normal Ada task master - -- hierarchy, much like the existing implicitly created signal-server - -- tasks. - - function Self return Task_Id is - Result : System.Address; - - begin - Result := RTEMS_Ada_Self; - - -- If the key value is Null, then it is a non-Ada task. - - if Result /= System.Null_Address then - return To_Task_Id (Result); - else - return Register_Foreign_Thread; - end if; - end Self; - -end Specific; diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0fa8b753c01..38a91f1dcbc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2005-01-27 Laurent GUERBY + + * Makefile.in: Rename GNAT RTEMS specific files. + * 5rtpopsp.adb, 4rintnam.ads, 5rosinte.adb, + 5rosinte.ads, 5rparame.adb: Replaced by files below. + * s-tpopsp-rtems.adb, a-intman-rtems.ads, s-osinte-rtems.adb, + s-osinte-rtems.ads, s-parame-rtems.adb: Replace files above. + 2005-01-27 Joel Sherrill Laurent GUERBY diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 610c9ac23cb..85c30cff3d7 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -1135,13 +1135,13 @@ ifeq ($(strip $(filter-out rtems%,$(osys))),) a-intnam.ads<4rintnam.ads \ s-inmaop.adb S, + tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); + end To_Timespec; + + function To_Duration (TV : struct_timeval) return Duration is + begin + return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; + end To_Duration; + + function To_Timeval (D : Duration) return struct_timeval is + S : int; + F : Duration; + begin + S := int (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 + struct_timeval' + (tv_sec => S, + tv_usec => int (Long_Long_Integer (F * 10#1#E6))); + end To_Timeval; + + procedure pthread_init is + begin + null; + end pthread_init; + + function Get_Stack_Base (thread : pthread_t) return Address is + pragma Warnings (Off, thread); + + begin + return Null_Address; + end Get_Stack_Base; + + function Get_Page_Size return size_t is + begin + return 0; + end Get_Page_Size; + + function Get_Page_Size return Address is + begin + return 0; + end Get_Page_Size; + +end System.OS_Interface; diff --git a/gcc/ada/s-osinte-rtems.ads b/gcc/ada/s-osinte-rtems.ads new file mode 100644 index 00000000000..c15362f70e0 --- /dev/null +++ b/gcc/ada/s-osinte-rtems.ads @@ -0,0 +1,531 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1997-2003 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 2, or (at your option) any later ver- -- +-- sion. GNARL 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +-- 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 + +-- These are guesses based on what I think the GNARL team will want to +-- call the rtems configurations. We use CPU-rtems for the rtems +-- configurations. + +-- This package encapsulates all direct interfaces to OS services +-- that are needed by children of System. + +-- PLEASE DO NOT add any with-clauses to this package +-- or remove the pragma Elaborate_Body. +-- It is designed to be a bottom-level (leaf) package. + +with Interfaces.C; +package System.OS_Interface is + pragma Preelaborate; + + -- This interface assumes that "unsigned" is a 32-bit entity. This + -- will correspond to RTEMS object ids. + + subtype rtems_id is Interfaces.C.unsigned; + + subtype int is Interfaces.C.int; + subtype short is Interfaces.C.short; + subtype long is Interfaces.C.long; + subtype unsigned is Interfaces.C.unsigned; + subtype unsigned_short is Interfaces.C.unsigned_short; + subtype unsigned_long is Interfaces.C.unsigned_long; + subtype unsigned_char is Interfaces.C.unsigned_char; + subtype plain_char is Interfaces.C.plain_char; + subtype size_t is Interfaces.C.size_t; + + ----------- + -- Errno -- + ----------- + + function errno return int; + pragma Import (C, errno, "__get_errno"); + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + ETIMEDOUT : constant := 116; + + ------------- + -- Signals -- + ------------- + + Max_Interrupt : constant := 31; + type Signal is new int range 0 .. Max_Interrupt; + + SIGXCPU : constant := 0; -- XCPU + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGEMT : constant := 7; -- EMT instruction + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 10; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGSYS : constant := 12; -- bad argument to system call + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 16; -- user defined signal 1 + SIGUSR2 : constant := 17; -- user defined signal 2 + + SIGADAABORT : constant := SIGABRT; + + type Signal_Set is array (Natural range <>) of Signal; + + Unmasked : constant Signal_Set := (SIGTRAP, SIGALRM, SIGEMT); + Reserved : constant Signal_Set := (1 .. 1 => SIGKILL); + + type sigset_t is private; + + function sigaddset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigaddset, "sigaddset"); + + function sigdelset (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigdelset, "sigdelset"); + + function sigfillset (set : access sigset_t) return int; + pragma Import (C, sigfillset, "sigfillset"); + + function sigismember (set : access sigset_t; sig : Signal) return int; + pragma Import (C, sigismember, "sigismember"); + + function sigemptyset (set : access sigset_t) return int; + pragma Import (C, sigemptyset, "sigemptyset"); + + type struct_sigaction is record + sa_flags : int; + sa_mask : sigset_t; + sa_handler : System.Address; + end record; + pragma Convention (C, struct_sigaction); + type struct_sigaction_ptr is access all struct_sigaction; + + SA_SIGINFO : constant := 16#02#; + + SIG_BLOCK : constant := 1; + SIG_UNBLOCK : constant := 2; + SIG_SETMASK : constant := 3; + + SIG_DFL : constant := 0; + SIG_IGN : constant := 1; + + function sigaction + (sig : Signal; + act : struct_sigaction_ptr; + oact : struct_sigaction_ptr) return int; + pragma Import (C, sigaction, "sigaction"); + + ---------- + -- Time -- + ---------- + + Time_Slice_Supported : constant Boolean := True; + -- Indicates wether time slicing is supported (i.e SCHED_RR is supported) + + type timespec is private; + + type clockid_t is private; + + CLOCK_REALTIME : constant clockid_t; + + function clock_gettime + (clock_id : clockid_t; + tp : access timespec) return int; + pragma Import (C, clock_gettime, "clock_gettime"); + + function To_Duration (TS : timespec) return Duration; + pragma Inline (To_Duration); + + function To_Timespec (D : Duration) return timespec; + pragma Inline (To_Timespec); + + type struct_timeval is private; + + function To_Duration (TV : struct_timeval) return Duration; + pragma Inline (To_Duration); + + function To_Timeval (D : Duration) return struct_timeval; + pragma Inline (To_Timeval); + + ------------------------- + -- Priority Scheduling -- + ------------------------- + + SCHED_FIFO : constant := 1; + SCHED_RR : constant := 2; + SCHED_OTHER : constant := 0; + + ------------- + -- Process -- + ------------- + + type pid_t is private; + + function kill (pid : pid_t; sig : Signal) return int; + pragma Import (C, kill, "kill"); + + function getpid return pid_t; + pragma Import (C, getpid, "getpid"); + + --------- + -- LWP -- + --------- + + function lwp_self return System.Address; + -- lwp_self does not exist on this thread library, revert to pthread_self + -- which is the closest approximation (with getpid). This function is + -- needed to share 7staprop.adb across POSIX-like targets. + pragma Import (C, lwp_self, "pthread_self"); + + ------------- + -- Threads -- + ------------- + + type Thread_Body is access + function (arg : System.Address) return System.Address; + + type pthread_t is private; + subtype Thread_Id is pthread_t; + + type pthread_mutex_t is limited private; + type pthread_cond_t is limited private; + type pthread_attr_t is limited private; + type pthread_mutexattr_t is limited private; + type pthread_condattr_t is limited private; + type pthread_key_t is private; + + No_Key : constant pthread_key_t; + + PTHREAD_CREATE_DETACHED : constant := 0; + + ----------- + -- Stack -- + ----------- + + Stack_Base_Available : constant Boolean := False; + -- Indicates wether the stack base is available on this target. + -- This allows us to share s-osinte.adb between all the FSU/RTEMS + -- run time. + -- Note that this value can only be true if pthread_t has a complete + -- definition that corresponds exactly to the C header files. + + function Get_Stack_Base (thread : pthread_t) return Address; + pragma Inline (Get_Stack_Base); + -- returns the stack base of the specified thread. + -- Only call this function when Stack_Base_Available is True. + + -- These two functions are only needed to share s-taprop.adb with + -- FSU threads. + + function Get_Page_Size return size_t; + function Get_Page_Size return Address; + -- returns the size of a page, or 0 if this is not relevant on this + -- target (which is the case for RTEMS) + + PROT_ON : constant := 0; + PROT_OFF : constant := 0; + + function mprotect (addr : Address; len : size_t; prot : int) return int; + pragma Import (C, mprotect); + + ----------------------------------------- + -- Nonstandard Thread Initialization -- + ----------------------------------------- + + procedure pthread_init; + -- FSU_THREADS requires pthread_init, which is nonstandard + -- and this should be invoked during the elaboration of s-taprop.adb + -- + -- RTEMS does not require this so we provide an empty Ada body. + + ------------------------- + -- POSIX.1c Section 3 -- + ------------------------- + + function sigwait + (set : access sigset_t; + sig : access Signal) return int; + pragma Import (C, sigwait, "sigwait"); + + function pthread_kill + (thread : pthread_t; + sig : Signal) return int; + pragma Import (C, pthread_kill, "pthread_kill"); + + type sigset_t_ptr is access all sigset_t; + + function pthread_sigmask + (how : int; + set : sigset_t_ptr; + oset : sigset_t_ptr) return int; + pragma Import (C, pthread_sigmask, "pthread_sigmask"); + + ---------------------------- + -- POSIX.1c Section 11 -- + ---------------------------- + + function pthread_mutexattr_init + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init"); + + function pthread_mutexattr_destroy + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy"); + + function pthread_mutex_init + (mutex : access pthread_mutex_t; + attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutex_init, "pthread_mutex_init"); + + function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy"); + + function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock"); + + function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock"); + + function pthread_condattr_init + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_init, "pthread_condattr_init"); + + function pthread_condattr_destroy + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy"); + + function pthread_cond_init + (cond : access pthread_cond_t; + attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_cond_init, "pthread_cond_init"); + + function pthread_cond_destroy (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy"); + + function pthread_cond_signal (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_signal, "pthread_cond_signal"); + + function pthread_cond_wait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_cond_wait, "pthread_cond_wait"); + + function pthread_cond_timedwait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t; + abstime : access timespec) return int; + pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait"); + + Relative_Timed_Wait : constant Boolean := False; + -- pthread_cond_timedwait requires an absolute delay time + + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- + + PTHREAD_PRIO_NONE : constant := 0; + PTHREAD_PRIO_PROTECT : constant := 2; + PTHREAD_PRIO_INHERIT : constant := 1; + + function pthread_mutexattr_setprotocol + (attr : access pthread_mutexattr_t; + protocol : int) return int; + pragma Import (C, pthread_mutexattr_setprotocol); + + function pthread_mutexattr_setprioceiling + (attr : access pthread_mutexattr_t; + prioceiling : int) return int; + pragma Import + (C, pthread_mutexattr_setprioceiling, + "pthread_mutexattr_setprioceiling"); + + type struct_sched_param is record + sched_priority : int; + ss_low_priority : timespec; + ss_replenish_period : timespec; + ss_initial_budget : timespec; + end record; + pragma Convention (C, struct_sched_param); + + function pthread_setschedparam + (thread : pthread_t; + policy : int; + param : access struct_sched_param) return int; + pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); + + function pthread_attr_setscope + (attr : access pthread_attr_t; + contentionscope : int) return int; + pragma Import (C, pthread_attr_setscope, "pthread_attr_setscope"); + + function pthread_attr_setinheritsched + (attr : access pthread_attr_t; + inheritsched : int) return int; + pragma Import (C, pthread_attr_setinheritsched); + + function pthread_attr_setschedpolicy + (attr : access pthread_attr_t; + policy : int) return int; + pragma Import (C, pthread_attr_setschedpolicy); + + function pthread_attr_setschedparam + (attr : access pthread_attr_t; + sched_param : int) return int; + pragma Import (C, pthread_attr_setschedparam); + + function sched_yield return int; + pragma Import (C, sched_yield, "sched_yield"); + + --------------------------- + -- P1003.1c - Section 16 -- + --------------------------- + + function pthread_attr_init (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_init, "pthread_attr_init"); + + function pthread_attr_destroy + (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy"); + + function pthread_attr_setdetachstate + (attr : access pthread_attr_t; + detachstate : int) return int; + pragma Import (C, pthread_attr_setdetachstate); + + function pthread_attr_setstacksize + (attr : access pthread_attr_t; + stacksize : size_t) return int; + pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize"); + + function pthread_create + (thread : access pthread_t; + attributes : access pthread_attr_t; + start_routine : Thread_Body; + arg : System.Address) return int; + pragma Import (C, pthread_create, "pthread_create"); + + procedure pthread_exit (status : System.Address); + pragma Import (C, pthread_exit, "pthread_exit"); + + function pthread_self return pthread_t; + pragma Import (C, pthread_self, "pthread_self"); + + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- + + function pthread_setspecific + (key : pthread_key_t; + value : System.Address) return int; + pragma Import (C, pthread_setspecific, "pthread_setspecific"); + + function pthread_getspecific (key : pthread_key_t) return System.Address; + pragma Import (C, pthread_getspecific, "pthread_getspecific"); + + type destructor_pointer is access procedure (arg : System.Address); + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) return int; + pragma Import (C, pthread_key_create, "pthread_key_create"); + +private + + type sigset_t is new int; + + type pid_t is new int; + + type time_t is new long; + + type timespec is record + tv_sec : time_t; + tv_nsec : long; + end record; + pragma Convention (C, timespec); + + type clockid_t is new rtems_id; + CLOCK_REALTIME : constant clockid_t := 1; + + type struct_timeval is record + tv_sec : int; + tv_usec : int; + end record; + pragma Convention (C, struct_timeval); + + type pthread_attr_t is record + is_initialized : int; + stackaddr : System.Address; + stacksize : int; + contentionscope : int; + inheritsched : int; + schedpolicy : int; + schedparam : struct_sched_param; + cputime_clocked_allowed : int; + deatchstate : int; + end record; + pragma Convention (C, pthread_attr_t); + + type pthread_condattr_t is record + flags : int; + end record; + pragma Convention (C, pthread_condattr_t); + + type pthread_mutexattr_t is record + is_initialized : int; + process_shared : int; + prio_ceiling : int; + protocol : int; + recursive : int; + end record; + pragma Convention (C, pthread_mutexattr_t); + + type pthread_t is new rtems_id; + + type pthread_mutex_t is new rtems_id; + + type pthread_cond_t is new rtems_id; + + type pthread_key_t is new rtems_id; + + No_Key : constant pthread_key_t := 0; + +end System.OS_Interface; diff --git a/gcc/ada/s-parame-rtems.adb b/gcc/ada/s-parame-rtems.adb new file mode 100644 index 00000000000..b6e15c776a8 --- /dev/null +++ b/gcc/ada/s-parame-rtems.adb @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . P A R A M E T E R S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1997-1998 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 2, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the RTEMS specific version + +with Interfaces.C; + +package body System.Parameters is + + function ada_pthread_minimum_stack_size return Interfaces.C.size_t; + pragma Import (C, ada_pthread_minimum_stack_size, + "_ada_pthread_minimum_stack_size"); + + ------------------------ + -- Default_Stack_Size -- + ------------------------ + + function Default_Stack_Size return Size_Type is + begin + return Size_Type (ada_pthread_minimum_stack_size); + end Default_Stack_Size; + + ------------------------ + -- Minimum_Stack_Size -- + ------------------------ + + function Minimum_Stack_Size return Size_Type is + + begin + return Size_Type (ada_pthread_minimum_stack_size); + end Minimum_Stack_Size; + + ------------------------- + -- Adjust_Storage_Size -- + ------------------------- + + function Adjust_Storage_Size (Size : Size_Type) return Size_Type is + begin + if Size = Unspecified_Size then + return Default_Stack_Size; + + elsif Size < Minimum_Stack_Size then + return Minimum_Stack_Size; + + else + return Size; + end if; + end Adjust_Storage_Size; + +end System.Parameters; diff --git a/gcc/ada/s-tpopsp-rtems.adb b/gcc/ada/s-tpopsp-rtems.adb new file mode 100644 index 00000000000..6c83352cd62 --- /dev/null +++ b/gcc/ada/s-tpopsp-rtems.adb @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S . -- +-- S P E C I F I C -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.2 $ +-- -- +-- Copyright (C) 1991-2003, Florida State University -- +-- -- +-- 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 2, or (at your option) any later ver- -- +-- sion. GNARL 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- 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). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a RTEMS version of this package which uses a special +-- variable for Ada self which is contexted switch implicitly by RTEMS. +-- +-- This is the same as the POSIX version except that an RTEMS variable +-- is used instead of a POSIX key. + +separate (System.Task_Primitives.Operations) +package body Specific is + + -- The following gives the Ada run-time direct access to a variable + -- context switched by RTEMS at the lowest level. + + RTEMS_Ada_Self : System.Address; + pragma Import (C, RTEMS_Ada_Self, "rtems_ada_self"); + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Environment_Task : Task_Id) is + pragma Warnings (Off, Environment_Task); + + begin + ATCB_Key := No_Key; + RTEMS_Ada_Self := To_Address (Environment_Task); + end Initialize; + + ------------------- + -- Is_Valid_Task -- + ------------------- + + function Is_Valid_Task return Boolean is + begin + return RTEMS_Ada_Self /= System.Null_Address; + end Is_Valid_Task; + + --------- + -- Set -- + --------- + + procedure Set (Self_Id : Task_Id) is + begin + RTEMS_Ada_Self := To_Address (Self_Id); + end Set; + + ---------- + -- Self -- + ---------- + + -- To make Ada tasks and C threads interoperate better, we have added some + -- functionality to Self. Suppose a C main program (with threads) calls an + -- Ada procedure and the Ada procedure calls the tasking runtime system. + -- Eventually, a call will be made to self. Since the call is not coming + -- from an Ada task, there will be no corresponding ATCB. + + -- What we do in Self is to catch references that do not come from + -- recognized Ada tasks, and create an ATCB for the calling thread. + + -- The new ATCB will be "detached" from the normal Ada task master + -- hierarchy, much like the existing implicitly created signal-server + -- tasks. + + function Self return Task_Id is + Result : System.Address; + + begin + Result := RTEMS_Ada_Self; + + -- If the key value is Null, then it is a non-Ada task. + + if Result /= System.Null_Address then + return To_Task_Id (Result); + else + return Register_Foreign_Thread; + end if; + end Self; + +end Specific;