#include "version.h"
#endif
-#if defined (__MINGW32__)
+#if defined (RTX)
+#include <windows.h>
+#include <Rtapi.h>
+#include <sys/utime.h>
+
+#elif defined (__MINGW32__)
#include "mingw32.h"
#include <sys/utime.h>
DIR* __gnat_opendir (char *name)
{
-#ifdef __MINGW32__
+#if defined (RTX)
+ /* Not supported in RTX */
+
+ return NULL;
+
+#elif defined (__MINGW32__)
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSU (wname, name, GNAT_MAX_PATH_LEN);
char *
__gnat_readdir (DIR *dirp, char *buffer, int *len)
{
-#if defined (__MINGW32__)
+#if defined (RTX)
+ /* Not supported in RTX */
+
+ return NULL;
+#elif defined (__MINGW32__)
struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
if (dirent != NULL)
int __gnat_closedir (DIR *dirp)
{
-#ifdef __MINGW32__
+#if defined (RTX)
+ /* Not supported in RTX */
+
+ return 0;
+
+#elif defined (__MINGW32__)
return _tclosedir ((_TDIR*)dirp);
#else
#endif
}
-#ifdef _WIN32
+#if defined (_WIN32) && !defined (RTX)
/* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
static const unsigned long long w32_epoch_offset = 11644473600ULL;
close (fd);
return (OS_Time)ret;
-#elif defined (_WIN32)
+#elif defined (_WIN32) && !defined (RTX)
time_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN];
tot_secs += file_tsec * 2;
return (OS_Time) tot_secs;
-#elif defined (_WIN32)
+#elif defined (_WIN32) && !defined (RTX)
HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h);
return (OS_Time) ret;
/* Code to implement __gnat_set_file_time_name for these systems. */
-#elif defined (_WIN32)
+#elif defined (_WIN32) && !defined (RTX)
union
{
FILETIME ft_time;
{
char *result = (char *) "";
-#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
+#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX)
HKEY reg_key;
DWORD name_size, value_size;
int
__gnat_file_exists (char *name)
{
-#ifdef __MINGW32__
+#if defined (__MINGW32__) && !defined (RTX)
/* On Windows do not use __gnat_stat() because a bug in Microsoft
_stat() routine. When the system time-zone is set with a negative
offset the _stat() routine fails on specific files like CON: */
int finished ATTRIBUTE_UNUSED;
int pid ATTRIBUTE_UNUSED;
-#if defined (MSDOS) || defined (_WIN32)
+#if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
+ return -1;
+
+#elif defined (MSDOS) || defined (_WIN32)
/* args[0] must be quotes as it could contain a full pathname with spaces */
char *args_0 = args[0];
args[0] = (char *)xmalloc (strlen (args_0) + 3);
else
return status;
-#elif defined (__vxworks) || defined(__nucleus__)
- return -1;
#else
#ifdef __EMX__
/* WIN32 code to implement a wait call that wait for any child process. */
-#ifdef _WIN32
+#if defined (_WIN32) && !defined (RTX)
/* Synchronization code, to be thread safe. */
{
int pid = 0;
-#if defined (__EMX__) || defined (MSDOS)
+#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
+ return -1;
+
+#elif defined (__EMX__) || defined (MSDOS)
/* ??? For PC machines I (Franco) don't know the system calls to implement
this routine. So I'll fake it as follows. This routine will behave
pid = win32_no_block_spawn (args[0], args);
return pid;
-#elif defined (__vxworks) || defined (__nucleus__)
- return -1;
-
#else
pid = fork ();
int status = 0;
int pid = 0;
-#if defined (_WIN32)
+#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
+ /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
+ return zero. */
+
+#elif defined (_WIN32)
pid = win32_wait (&status);
#elif defined (__EMX__) || defined (MSDOS)
/* ??? See corresponding comment in portable_no_block_spawn. */
-#elif defined (__vxworks) || defined (__nucleus__)
- /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
- return zero. */
#else
pid = waitpid (-1, &status, 0);
{
char *apath_val;
-#ifdef _WIN32
+#if defined (_WIN32) && !defined (RTX)
TCHAR *wpath_val = _tgetenv (_T("PATH"));
TCHAR *wapath_val;
/* In Win32 systems we expand the PATH as for XP environment
return 1;
#endif
}
+
+/* In RTX mode, the procedure to get the time (as file time) is different
+ in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
+ we introduce an intermediate procedure to link against the corresponding
+ one in each situation. */
+#ifdef RTX
+
+void GetTimeAsFileTime(LPFILETIME pTime)
+{
+#ifdef RTSS
+ RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
+#else
+ GetSystemTimeAsFileTime (pTime); /* w32 interface */
+#endif
+}
+#endif
+
+#if defined (linux)
+/* pthread affinity support */
+
+#ifdef CPU_SETSIZE
+#include <pthread.h>
+int
+__gnat_pthread_setaffinity_np (pthread_t th,
+ size_t cpusetsize,
+ const cpu_set_t *cpuset)
+{
+ return pthread_setaffinity_np (th, cpusetsize, cpuset);
+}
+#else
+int
+__gnat_pthread_setaffinity_np (pthread_t th,
+ size_t cpusetsize,
+ const void *cpuset)
+{
+ return 0;
+}
+#endif
+#endif
function sysconf (name : int) return long;
pragma Import (C, sysconf);
- SC_CLK_TCK : constant := 2;
+ SC_CLK_TCK : constant := 2;
+ SC_NPROCESSORS_ONLN : constant := 84;
-------------------------
-- Priority Scheduling --
function To_Target_Priority
(Prio : System.Any_Priority) return Interfaces.C.int;
- -- Maps System.Any_Priority to a POSIX priority.
+ -- Maps System.Any_Priority to a POSIX priority
-------------
-- Process --
type Thread_Body is access
function (arg : System.Address) return System.Address;
+ pragma Convention (C, Thread_Body);
function Thread_Body_Access is new
Ada.Unchecked_Conversion (System.Address, Thread_Body);
pragma Import (C, pthread_getspecific, "pthread_getspecific");
type destructor_pointer is access procedure (arg : System.Address);
+ pragma Convention (C, destructor_pointer);
function pthread_key_create
(key : access pthread_key_t;
destructor : destructor_pointer) return int;
pragma Import (C, pthread_key_create, "pthread_key_create");
+ CPU_SETSIZE : constant := 1_024;
+
+ type bit_field is array (1 .. CPU_SETSIZE) of Boolean;
+ for bit_field'Size use CPU_SETSIZE;
+ pragma Pack (bit_field);
+ pragma Convention (C, bit_field);
+
+ type cpu_set_t is record
+ bits : bit_field;
+ end record;
+ pragma Convention (C, cpu_set_t);
+
+ function pthread_setaffinity_np
+ (thread : pthread_t;
+ cpusetsize : size_t;
+ cpuset : access cpu_set_t) return int;
+ pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np");
+
private
type sigset_t is array (0 .. 127) of unsigned_char;
-- used for int
-- size_t
+with System.Task_Info;
+-- used for Unspecified_Task_Info
+
with System.Tasking.Debug;
-- used for Known_Tasks
use System.Parameters;
use System.OS_Primitives;
use System.Storage_Elements;
+ use System.Task_Info;
----------------
-- Local Data --
procedure Enter_Task (Self_ID : Task_Id) is
begin
+ if Self_ID.Common.Task_Info /= null
+ and then
+ Self_ID.Common.Task_Info.CPU_Affinity = No_CPU
+ then
+ raise Invalid_CPU_Number;
+ end if;
+
Self_ID.Common.LL.Thread := pthread_self;
Specific.Set (Self_ID);
Succeeded := Result = 0;
+ -- Handle Task_Info
+
+ if T.Common.Task_Info /= null then
+ if T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU then
+ Result :=
+ pthread_setaffinity_np
+ (T.Common.LL.Thread,
+ CPU_SETSIZE / 8,
+ T.Common.Task_Info.CPU_Affinity'Access);
+ pragma Assert (Result = 0);
+ end if;
+ end if;
+
Result := pthread_attr_destroy (Attributes'Access);
pragma Assert (Result = 0);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . T A S K _ I N F O --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2007, 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, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, 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 GNU/Linux version of this module
+
+package body System.Task_Info is
+
+ N_CPU : Natural := 0;
+ pragma Atomic (N_CPU);
+ -- Cache CPU number. Use pragma Atomic to avoid a race condition when
+ -- setting N_CPU in Number_Of_Processors below.
+
+ --------------------------
+ -- Number_Of_Processors --
+ --------------------------
+
+ function Number_Of_Processors return Positive is
+ begin
+ if N_CPU = 0 then
+ N_CPU := Natural
+ (OS_Interface.sysconf (OS_Interface.SC_NPROCESSORS_ONLN));
+ end if;
+
+ return N_CPU;
+ end Number_Of_Processors;
+
+end System.Task_Info;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . T A S K _ I N F O --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2007, 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, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, 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 package contains the definitions and routines associated with the
+-- implementation and use of the Task_Info pragma. It is specialized
+-- appropriately for targets that make use of this pragma.
+
+-- Note: the compiler generates direct calls to this interface, via Rtsfind.
+-- Any changes to this interface may require corresponding compiler changes.
+
+-- This unit may be used directly from an application program by providing
+-- an appropriate WITH, and the interface can be expected to remain stable.
+
+-- This is the GNU/Linux version of this module.
+
+with System.OS_Interface;
+
+package System.Task_Info is
+ pragma Preelaborate;
+ pragma Elaborate_Body;
+ -- To ensure that a body is allowed
+
+ -- Windows provides a way to define the ideal processor to use for a given
+ -- thread. The ideal processor is not necessarily the one that will be used
+ -- by the OS but the OS will always try to schedule this thread to the
+ -- specified processor if it is available.
+
+ -- The Task_Info pragma:
+
+ -- pragma Task_Info (EXPRESSION);
+
+ -- allows the specification on a task by task basis of a value of type
+ -- System.Task_Info.Task_Info_Type to be passed to a task when it is
+ -- created. The specification of this type, and the effect on the task
+ -- that is created is target dependent.
+
+ -- The Task_Info pragma appears within a task definition (compare the
+ -- definition and implementation of pragma Priority). If no such pragma
+ -- appears, then the value Unspecified_Task_Info is passed. If a pragma
+ -- is present, then it supplies an alternative value. If the argument of
+ -- the pragma is a discriminant reference, then the value can be set on
+ -- a task by task basis by supplying the appropriate discriminant value.
+
+ -- Note that this means that the type used for Task_Info_Type must be
+ -- suitable for use as a discriminant (i.e. a scalar or access type).
+
+ -----------------------
+ -- Thread Attributes --
+ -----------------------
+
+ subtype CPU_Set is System.OS_Interface.cpu_set_t;
+
+ Any_CPU : constant CPU_Set := (bits => (others => True));
+ No_CPU : constant CPU_Set := (bits => (others => False));
+
+ Invalid_CPU_Number : exception;
+ -- Raised when an invalid CPU mask has been specified
+ -- i.e. An empty CPU set
+
+ type Thread_Attributes is record
+ CPU_Affinity : aliased CPU_Set := Any_CPU;
+ end record;
+
+ Default_Thread_Attributes : constant Thread_Attributes := (others => <>);
+
+ type Task_Info_Type is access all Thread_Attributes;
+
+ Unspecified_Task_Info : constant Task_Info_Type := null;
+
+ function Number_Of_Processors return Positive;
+ -- Returns the number of processors on the running host
+
+end System.Task_Info;
OSDN Git Service
