Makefile.in: Add target pairs for powerpc darwin* tasking support.
* Makefile.in: Add target pairs for powerpc darwin* tasking support. * a-intnam-darwin.ads, s-osinte-darwin.adb, s-osinte-darwin.ads, system-darwin-ppc.ads: New files. From-SVN: r81245
This commit is contained in:
parent
83532fb78e
commit
c470d7c9d3
|
@ -1307,7 +1307,21 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
|
||||||
GMEM_LIB = gmemlib
|
GMEM_LIB = gmemlib
|
||||||
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
|
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
|
||||||
LIBRARY_VERSION := $(LIB_VERSION)
|
LIBRARY_VERSION := $(LIB_VERSION)
|
||||||
|
endif
|
||||||
|
|
||||||
|
ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
|
||||||
|
LIBGNAT_TARGET_PAIRS = \
|
||||||
|
a-intnam.ads<a-intnam-darwin.ads \
|
||||||
|
s-inmaop.adb<7sinmaop.adb \
|
||||||
|
s-intman.adb<7sintman.adb \
|
||||||
|
s-osinte.adb<s-osinte-darwin.adb \
|
||||||
|
s-osinte.ads<s-osinte-darwin.ads \
|
||||||
|
s-osprim.adb<7sosprim.adb \
|
||||||
|
s-taprop.adb<7staprop.adb \
|
||||||
|
s-taspri.ads<7staspri.ads \
|
||||||
|
s-tpopsp.adb<5atpopsp.adb \
|
||||||
|
g-soccon.ads<3bsoccon.ads \
|
||||||
|
system.ads<system-darwin-ppc.ads
|
||||||
endif
|
endif
|
||||||
|
|
||||||
# The runtime library for gnat comprises two directories. One contains the
|
# The runtime library for gnat comprises two directories. One contains the
|
||||||
|
@ -1909,7 +1923,7 @@ gnatlib-shared-default:
|
||||||
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS)" \
|
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS)" \
|
||||||
THREAD_KIND="$(THREAD_KIND)" \
|
THREAD_KIND="$(THREAD_KIND)" \
|
||||||
gnatlib
|
gnatlib
|
||||||
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
|
$(RM) rts/libgna*$(soext)
|
||||||
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
|
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
|
||||||
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
|
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
|
||||||
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
|
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
|
||||||
|
@ -1965,7 +1979,7 @@ gnatlib-shared-win32:
|
||||||
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS)" \
|
GNATLIBCFLAGS="$(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS)" \
|
||||||
THREAD_KIND="$(THREAD_KIND)" \
|
THREAD_KIND="$(THREAD_KIND)" \
|
||||||
gnatlib
|
gnatlib
|
||||||
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
|
$(RM) rts/libgna*$(soext)
|
||||||
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
|
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
|
||||||
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
|
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
|
||||||
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
|
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
|
||||||
|
@ -1982,7 +1996,7 @@ gnatlib-shared-vms:
|
||||||
GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
|
GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
|
||||||
THREAD_KIND="$(THREAD_KIND)" \
|
THREAD_KIND="$(THREAD_KIND)" \
|
||||||
gnatlib
|
gnatlib
|
||||||
$(RM) rts/libgnat*$(soext) rts/libgnarl*$(soext)
|
$(RM) rts/libgna*$(soext)
|
||||||
cd rts && echo "case_sensitive=yes" > SYMVEC_$$$$.opt && \
|
cd rts && echo "case_sensitive=yes" > SYMVEC_$$$$.opt && \
|
||||||
objdump --syms $(LIBGNAT_OBJS) $(GNATRTL_NONTASKING_OBJS) | \
|
objdump --syms $(LIBGNAT_OBJS) $(GNATRTL_NONTASKING_OBJS) | \
|
||||||
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
|
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
|
||||||
|
|
|
@ -0,0 +1,153 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- 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-2004 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. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- This is the Darwin version of this package.
|
||||||
|
--
|
||||||
|
-- The following signals are reserved by the run time:
|
||||||
|
--
|
||||||
|
-- SIGSTOP, SIGKILL
|
||||||
|
--
|
||||||
|
-- The pragma Unreserve_All_Interrupts affects the following signal(s):
|
||||||
|
--
|
||||||
|
-- SIGINT: made available for Ada handler
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
SIGURG : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGURG; -- urgent condition on IO channel
|
||||||
|
|
||||||
|
SIGSTOP : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored)
|
||||||
|
|
||||||
|
SIGTSTP : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGTSTP; -- user stop requested from tty
|
||||||
|
|
||||||
|
SIGCONT : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGCONT; -- stopped process has been continued
|
||||||
|
|
||||||
|
SIGCHLD : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD
|
||||||
|
|
||||||
|
SIGTTIN : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGTTIN; -- background tty read attempted
|
||||||
|
|
||||||
|
SIGTTOU : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGTTOU; -- background tty write attempted
|
||||||
|
|
||||||
|
SIGIO : constant Interrupt_ID := -- input/output possible,
|
||||||
|
System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris)
|
||||||
|
|
||||||
|
SIGXCPU : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGXCPU; -- CPU time limit exceeded
|
||||||
|
|
||||||
|
SIGXFSZ : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGXFSZ; -- filesize limit exceeded
|
||||||
|
|
||||||
|
SIGVTALRM : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGVTALRM; -- virtual timer expired
|
||||||
|
|
||||||
|
SIGPROF : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGPROF; -- profiling timer expired
|
||||||
|
|
||||||
|
SIGWINCH : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGWINCH; -- window size change
|
||||||
|
|
||||||
|
SIGINFO : constant Interrupt_ID :=
|
||||||
|
System.OS_Interface.SIGINFO; -- information request
|
||||||
|
|
||||||
|
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;
|
|
@ -0,0 +1,163 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- 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) 1999-2004 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. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- This is a Darwin Threads 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.
|
||||||
|
|
||||||
|
with Interfaces.C;
|
||||||
|
|
||||||
|
package body System.OS_Interface is
|
||||||
|
|
||||||
|
use Interfaces.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;
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
-- 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;
|
||||||
|
|
||||||
|
----------------
|
||||||
|
-- To_Timeval --
|
||||||
|
----------------
|
||||||
|
|
||||||
|
function To_Timeval (D : Duration) return struct_timeval is
|
||||||
|
S : long;
|
||||||
|
F : Duration;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S := long (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 => long (Long_Long_Integer (F * 10#1#E6)));
|
||||||
|
end To_Timeval;
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
-- clock_gettime --
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
function clock_gettime
|
||||||
|
(clock_id : clockid_t;
|
||||||
|
tp : access timespec) return int
|
||||||
|
is
|
||||||
|
pragma Unreferenced (clock_id);
|
||||||
|
Result : int;
|
||||||
|
tv : aliased struct_timeval;
|
||||||
|
|
||||||
|
function gettimeofday
|
||||||
|
(tv : access struct_timeval;
|
||||||
|
tz : System.Address := System.Null_Address) return int;
|
||||||
|
pragma Import (C, gettimeofday, "gettimeofday");
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := gettimeofday (tv'Unchecked_Access);
|
||||||
|
tp.all := To_Timespec (To_Duration (tv));
|
||||||
|
return Result;
|
||||||
|
end clock_gettime;
|
||||||
|
|
||||||
|
-----------------
|
||||||
|
-- sched_yield --
|
||||||
|
-----------------
|
||||||
|
|
||||||
|
function sched_yield return int is
|
||||||
|
procedure sched_yield_base (arg : System.Address);
|
||||||
|
pragma Import (C, sched_yield_base, "pthread_yield_np");
|
||||||
|
|
||||||
|
begin
|
||||||
|
sched_yield_base (System.Null_Address);
|
||||||
|
return 0;
|
||||||
|
end sched_yield;
|
||||||
|
|
||||||
|
------------------
|
||||||
|
-- pthread_init --
|
||||||
|
------------------
|
||||||
|
|
||||||
|
procedure pthread_init is
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end pthread_init;
|
||||||
|
|
||||||
|
----------------
|
||||||
|
-- Stack_Base --
|
||||||
|
----------------
|
||||||
|
|
||||||
|
function Get_Stack_Base (thread : pthread_t) return Address is
|
||||||
|
pragma Unreferenced (thread);
|
||||||
|
begin
|
||||||
|
return System.Null_Address;
|
||||||
|
end Get_Stack_Base;
|
||||||
|
|
||||||
|
end System.OS_Interface;
|
|
@ -0,0 +1,641 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- 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) 1991-1994, Florida State University --
|
||||||
|
-- Copyright (C) 1995-2004, 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. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- This is Darwin pthreads version of this package.
|
||||||
|
|
||||||
|
-- This package includes 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;
|
||||||
|
|
||||||
|
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");
|
||||||
|
|
||||||
|
EINTR : constant := 4;
|
||||||
|
ENOMEM : constant := 12;
|
||||||
|
EINVAL : constant := 22;
|
||||||
|
EAGAIN : constant := 35;
|
||||||
|
ETIMEDOUT : constant := 60;
|
||||||
|
|
||||||
|
-------------
|
||||||
|
-- Signals --
|
||||||
|
-------------
|
||||||
|
|
||||||
|
Max_Interrupt : constant := 31;
|
||||||
|
type Signal is new int range 0 .. Max_Interrupt;
|
||||||
|
for Signal'Size use int'Size;
|
||||||
|
|
||||||
|
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
|
||||||
|
SIGURG : constant := 16; -- urgent condition on IO channel
|
||||||
|
SIGSTOP : constant := 17; -- stop (cannot be caught or ignored)
|
||||||
|
SIGTSTP : constant := 18; -- user stop requested from tty
|
||||||
|
SIGCONT : constant := 19; -- stopped process has been continued
|
||||||
|
SIGCHLD : constant := 20; -- child status change
|
||||||
|
SIGTTIN : constant := 21; -- background tty read attempted
|
||||||
|
SIGTTOU : constant := 22; -- background tty write attempted
|
||||||
|
SIGIO : constant := 23; -- I/O possible (Solaris SIGPOLL alias)
|
||||||
|
SIGXCPU : constant := 24; -- CPU time limit exceeded
|
||||||
|
SIGXFSZ : constant := 25; -- filesize limit exceeded
|
||||||
|
SIGVTALRM : constant := 26; -- virtual timer expired
|
||||||
|
SIGPROF : constant := 27; -- profiling timer expired
|
||||||
|
SIGWINCH : constant := 28; -- window size change
|
||||||
|
SIGINFO : constant := 29; -- information request
|
||||||
|
SIGUSR1 : constant := 30; -- user defined signal 1
|
||||||
|
SIGUSR2 : constant := 31; -- user defined signal 2
|
||||||
|
|
||||||
|
SIGADAABORT : constant := SIGABRT;
|
||||||
|
-- Change this if you want to use another signal for task abort.
|
||||||
|
-- SIGTERM might be a good one.
|
||||||
|
|
||||||
|
type Signal_Set is array (Natural range <>) of Signal;
|
||||||
|
|
||||||
|
Unmasked : constant Signal_Set :=
|
||||||
|
(SIGTTIN, SIGTTOU, SIGSTOP, SIGTSTP);
|
||||||
|
|
||||||
|
Reserved : constant Signal_Set :=
|
||||||
|
(SIGKILL, SIGSTOP);
|
||||||
|
|
||||||
|
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 siginfo_t is private;
|
||||||
|
type ucontext_t is private;
|
||||||
|
|
||||||
|
type Signal_Handler is access procedure
|
||||||
|
(signo : Signal;
|
||||||
|
info : access siginfo_t;
|
||||||
|
context : access ucontext_t);
|
||||||
|
|
||||||
|
type struct_sigaction is record
|
||||||
|
sa_handler : System.Address;
|
||||||
|
sa_mask : sigset_t;
|
||||||
|
sa_flags : int;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, struct_sigaction);
|
||||||
|
type struct_sigaction_ptr is access all struct_sigaction;
|
||||||
|
|
||||||
|
SIG_BLOCK : constant := 1;
|
||||||
|
SIG_UNBLOCK : constant := 2;
|
||||||
|
SIG_SETMASK : constant := 3;
|
||||||
|
|
||||||
|
SIG_DFL : constant := 0;
|
||||||
|
SIG_IGN : constant := 1;
|
||||||
|
|
||||||
|
SA_SIGINFO : constant := 16#0040#;
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
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;
|
||||||
|
|
||||||
|
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_OTHER : constant := 1;
|
||||||
|
SCHED_RR : constant := 2;
|
||||||
|
SCHED_FIFO : constant := 4;
|
||||||
|
|
||||||
|
-------------
|
||||||
|
-- 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;
|
||||||
|
|
||||||
|
type pthread_mutex_ptr is access all pthread_mutex_t;
|
||||||
|
type pthread_cond_ptr is access all pthread_cond_t;
|
||||||
|
|
||||||
|
PTHREAD_CREATE_DETACHED : constant := 2;
|
||||||
|
|
||||||
|
-----------
|
||||||
|
-- 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 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 System.Address;
|
||||||
|
pragma Inline (Get_Stack_Base);
|
||||||
|
-- returns the stack base of the specified thread.
|
||||||
|
-- Only call this function when Stack_Base_Available is True.
|
||||||
|
|
||||||
|
function Get_Page_Size return size_t;
|
||||||
|
function Get_Page_Size return System.Address;
|
||||||
|
pragma Import (C, Get_Page_Size, "getpagesize");
|
||||||
|
-- returns the size of a page, or 0 if this is not relevant on this
|
||||||
|
-- target
|
||||||
|
|
||||||
|
PROT_NONE : constant := 0;
|
||||||
|
PROT_READ : constant := 1;
|
||||||
|
PROT_WRITE : constant := 2;
|
||||||
|
PROT_EXEC : constant := 4;
|
||||||
|
PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
|
||||||
|
|
||||||
|
PROT_ON : constant := PROT_NONE;
|
||||||
|
PROT_OFF : constant := PROT_ALL;
|
||||||
|
|
||||||
|
function mprotect (addr : System.Address;
|
||||||
|
len : size_t;
|
||||||
|
prot : int) return int;
|
||||||
|
pragma Import (C, mprotect);
|
||||||
|
|
||||||
|
---------------------------------------
|
||||||
|
-- Nonstandard Thread Initialization --
|
||||||
|
---------------------------------------
|
||||||
|
|
||||||
|
procedure pthread_init;
|
||||||
|
|
||||||
|
-------------------------
|
||||||
|
-- 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, "sigprocmask");
|
||||||
|
|
||||||
|
--------------------------
|
||||||
|
-- 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_INHERIT : constant := 1;
|
||||||
|
PTHREAD_PRIO_PROTECT : constant := 2;
|
||||||
|
|
||||||
|
function pthread_mutexattr_setprotocol
|
||||||
|
(attr : access pthread_mutexattr_t;
|
||||||
|
protocol : int) return int;
|
||||||
|
pragma Import
|
||||||
|
(C, pthread_mutexattr_setprotocol, "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; -- scheduling priority
|
||||||
|
end record;
|
||||||
|
|
||||||
|
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, "pthread_attr_setinheritsched");
|
||||||
|
|
||||||
|
function pthread_attr_setschedpolicy
|
||||||
|
(attr : access pthread_attr_t;
|
||||||
|
policy : int) return int;
|
||||||
|
pragma Import (C, pthread_attr_setschedpolicy, "pthread_attr_setsched");
|
||||||
|
|
||||||
|
function sched_yield return int;
|
||||||
|
|
||||||
|
---------------------------
|
||||||
|
-- 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, "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 array_type_1 is array (Integer range 0 .. 3) of unsigned_long;
|
||||||
|
type sigset_t is record
|
||||||
|
X_X_sigbits : array_type_1;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, sigset_t);
|
||||||
|
|
||||||
|
type pid_t is new long;
|
||||||
|
|
||||||
|
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 int;
|
||||||
|
CLOCK_REALTIME : constant clockid_t := 0;
|
||||||
|
|
||||||
|
type struct_timeval is record
|
||||||
|
tv_sec : long;
|
||||||
|
tv_usec : long;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, struct_timeval);
|
||||||
|
|
||||||
|
--
|
||||||
|
-- Darwin specific signal implementation
|
||||||
|
--
|
||||||
|
type Pad_Type is array (0 .. 7) of int;
|
||||||
|
type siginfo_t is record
|
||||||
|
si_signo : int; -- signal number
|
||||||
|
si_errno : int; -- errno association
|
||||||
|
si_code : int; -- signal code
|
||||||
|
si_pid : int; -- sending process
|
||||||
|
si_uid : unsigned; -- sender's ruid
|
||||||
|
si_status : int; -- exit value
|
||||||
|
si_addr : System.Address; -- faulting instruction
|
||||||
|
si_value : System.Address; -- signal value
|
||||||
|
si_band : long; -- band event for SIGPOLL
|
||||||
|
pad : Pad_Type; -- RFU
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, siginfo_t);
|
||||||
|
|
||||||
|
type stack_t is record
|
||||||
|
ss_sp : System.Address;
|
||||||
|
ss_size : int;
|
||||||
|
ss_flags : int;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, stack_t);
|
||||||
|
|
||||||
|
type mcontext_t is new System.Address;
|
||||||
|
|
||||||
|
type ucontext_t is record
|
||||||
|
uc_onstack : int;
|
||||||
|
uc_sigmask : sigset_t; -- Signal Mask Used By This Context
|
||||||
|
uc_stack : stack_t; -- Stack Used By This Context
|
||||||
|
uc_link : System.Address; -- Pointer To Resuming Context
|
||||||
|
uc_mcsize : size_t; -- Size of The Machine Context
|
||||||
|
uc_mcontext : mcontext_t; -- Machine Specific Context
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, ucontext_t);
|
||||||
|
|
||||||
|
--
|
||||||
|
-- Darwin specific pthread implementation
|
||||||
|
--
|
||||||
|
type pthread_t is new System.Address;
|
||||||
|
|
||||||
|
type pthread_lock_t is new long;
|
||||||
|
|
||||||
|
type sched_param_pad is array (0 .. 3) of plain_char;
|
||||||
|
type sched_param is record
|
||||||
|
sched_priority : int;
|
||||||
|
opaque : sched_param_pad;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, sched_param);
|
||||||
|
type boolean_t is new int;
|
||||||
|
|
||||||
|
type pthread_attr_t is record
|
||||||
|
sig : long;
|
||||||
|
lock : pthread_lock_t;
|
||||||
|
detached : int;
|
||||||
|
inherit : int;
|
||||||
|
policy : int;
|
||||||
|
param : sched_param;
|
||||||
|
stackaddr : System.Address;
|
||||||
|
stacksize : long;
|
||||||
|
freeStackOnExit : boolean_t;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_attr_t);
|
||||||
|
|
||||||
|
type pthread_mutexattr_t is record
|
||||||
|
sig : long;
|
||||||
|
prioceiling : int;
|
||||||
|
protocol : int;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_mutexattr_t);
|
||||||
|
|
||||||
|
type mach_port_t is new unsigned_long;
|
||||||
|
|
||||||
|
type pthread_mutex_t is record
|
||||||
|
sig : long;
|
||||||
|
lock : pthread_lock_t;
|
||||||
|
prioceiling : int;
|
||||||
|
priority : int;
|
||||||
|
protocol : int;
|
||||||
|
owner : pthread_t;
|
||||||
|
next : pthread_mutex_ptr;
|
||||||
|
prev : pthread_mutex_ptr;
|
||||||
|
busy : pthread_cond_ptr;
|
||||||
|
field : int;
|
||||||
|
sem : mach_port_t;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_mutex_t);
|
||||||
|
|
||||||
|
type pthread_condattr_t is record
|
||||||
|
sig : long;
|
||||||
|
unsupported : int;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_condattr_t);
|
||||||
|
|
||||||
|
type pthread_cond_t is record
|
||||||
|
sig : long;
|
||||||
|
lock : pthread_lock_t;
|
||||||
|
sem : mach_port_t;
|
||||||
|
next : pthread_cond_ptr;
|
||||||
|
prev : pthread_cond_ptr;
|
||||||
|
busy : pthread_mutex_ptr;
|
||||||
|
waiters : short;
|
||||||
|
sigspending : short;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_cond_t);
|
||||||
|
|
||||||
|
type pthread_once_t is record
|
||||||
|
sig : long;
|
||||||
|
lock : pthread_lock_t;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_once_t);
|
||||||
|
|
||||||
|
type rwlockattr_rfu_array is array (0 .. 1) of int;
|
||||||
|
|
||||||
|
type pthread_rwlockattr_t is record
|
||||||
|
sig : long;
|
||||||
|
pshared : int;
|
||||||
|
rfu : rwlockattr_rfu_array;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_rwlockattr_t);
|
||||||
|
|
||||||
|
type rwlock_rfu_array is array (0 .. 2) of int;
|
||||||
|
|
||||||
|
type pthread_rwlock_t is record
|
||||||
|
sig : long;
|
||||||
|
lock : pthread_mutex_t;
|
||||||
|
state : int;
|
||||||
|
read_signal : pthread_cond_t;
|
||||||
|
write_signal : pthread_cond_t;
|
||||||
|
block_writers : int;
|
||||||
|
pshared : int;
|
||||||
|
rfu : rwlock_rfu_array;
|
||||||
|
end record;
|
||||||
|
pragma Convention (C, pthread_rwlock_t);
|
||||||
|
|
||||||
|
type pthread_key_t is new unsigned_long;
|
||||||
|
|
||||||
|
end System.OS_Interface;
|
|
@ -0,0 +1,176 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- GNAT RUN-TIME COMPONENTS --
|
||||||
|
-- --
|
||||||
|
-- S Y S T E M --
|
||||||
|
-- --
|
||||||
|
-- S p e c --
|
||||||
|
-- (Darwin/PPC Version) --
|
||||||
|
-- --
|
||||||
|
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||||
|
-- --
|
||||||
|
-- This specification is derived from the Ada Reference Manual for use with --
|
||||||
|
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||||
|
-- apply solely to the contents of the part following the private keyword. --
|
||||||
|
-- --
|
||||||
|
-- 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. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
package System is
|
||||||
|
pragma Pure (System);
|
||||||
|
-- Note that we take advantage of the implementation permission to
|
||||||
|
-- make this unit Pure instead of Preelaborable, see RM 13.7(36)
|
||||||
|
|
||||||
|
type Name is (SYSTEM_NAME_GNAT);
|
||||||
|
System_Name : constant Name := SYSTEM_NAME_GNAT;
|
||||||
|
|
||||||
|
-- System-Dependent Named Numbers
|
||||||
|
|
||||||
|
Min_Int : constant := Long_Long_Integer'First;
|
||||||
|
Max_Int : constant := Long_Long_Integer'Last;
|
||||||
|
|
||||||
|
Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
|
||||||
|
Max_Nonbinary_Modulus : constant := Integer'Last;
|
||||||
|
|
||||||
|
Max_Base_Digits : constant := Long_Long_Float'Digits;
|
||||||
|
Max_Digits : constant := Long_Long_Float'Digits;
|
||||||
|
|
||||||
|
Max_Mantissa : constant := 63;
|
||||||
|
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
|
||||||
|
|
||||||
|
Tick : constant := 0.01;
|
||||||
|
|
||||||
|
-- Storage-related Declarations
|
||||||
|
|
||||||
|
type Address is private;
|
||||||
|
Null_Address : constant Address;
|
||||||
|
|
||||||
|
Storage_Unit : constant := 8;
|
||||||
|
Word_Size : constant := 32;
|
||||||
|
Memory_Size : constant := 2 ** 32;
|
||||||
|
|
||||||
|
-- Address comparison
|
||||||
|
|
||||||
|
function "<" (Left, Right : Address) return Boolean;
|
||||||
|
function "<=" (Left, Right : Address) return Boolean;
|
||||||
|
function ">" (Left, Right : Address) return Boolean;
|
||||||
|
function ">=" (Left, Right : Address) return Boolean;
|
||||||
|
function "=" (Left, Right : Address) return Boolean;
|
||||||
|
|
||||||
|
pragma Import (Intrinsic, "<");
|
||||||
|
pragma Import (Intrinsic, "<=");
|
||||||
|
pragma Import (Intrinsic, ">");
|
||||||
|
pragma Import (Intrinsic, ">=");
|
||||||
|
pragma Import (Intrinsic, "=");
|
||||||
|
|
||||||
|
-- Other System-Dependent Declarations
|
||||||
|
|
||||||
|
type Bit_Order is (High_Order_First, Low_Order_First);
|
||||||
|
Default_Bit_Order : constant Bit_Order := High_Order_First;
|
||||||
|
|
||||||
|
-- Priority-related Declarations (RM D.1)
|
||||||
|
|
||||||
|
-- The values defined here are derived from the following Darwin
|
||||||
|
-- sources:
|
||||||
|
--
|
||||||
|
-- Libc/pthreads/pthread.c
|
||||||
|
-- pthread_init calls host_info to retrieve the HOST_PRIORITY_INFO.
|
||||||
|
-- This file includes "pthread_internals".
|
||||||
|
-- Libc/pthreads/pthread_internals.h
|
||||||
|
-- This file includes <mach/mach.h>.
|
||||||
|
-- xnu/osfmk/mach/mach.h
|
||||||
|
-- This file includes <mach/mach_types.h>.
|
||||||
|
-- xnu/osfmk/mach/mach_types.h
|
||||||
|
-- This file includes <mach/host_info.h>.
|
||||||
|
-- xnu/osfmk/mach/host_info.h
|
||||||
|
-- This file contains the definition of the host_info_t data structure
|
||||||
|
-- and the function prototype for host_info.
|
||||||
|
-- xnu/osfmk/kern/host.c
|
||||||
|
-- This file defines the function host_info which sets the
|
||||||
|
-- priority_info field of struct host_info_t. This file includes
|
||||||
|
-- <kern/processor.h>.
|
||||||
|
-- xnu/osfmk/kern/processor.h
|
||||||
|
-- This file includes <kern/sched.h>.
|
||||||
|
-- xnu/osfmk/kern/sched.h
|
||||||
|
-- This file defines the values for each level of priority.
|
||||||
|
|
||||||
|
Max_Interrupt_Priority : constant Positive := 63;
|
||||||
|
Max_Priority : constant Positive := Max_Interrupt_Priority - 1;
|
||||||
|
|
||||||
|
subtype Any_Priority is Integer range 0 .. Max_Interrupt_Priority;
|
||||||
|
subtype Priority is Any_Priority range 0 .. Max_Priority;
|
||||||
|
subtype Interrupt_Priority is Any_Priority
|
||||||
|
range Priority'Last + 1 .. Max_Interrupt_Priority;
|
||||||
|
|
||||||
|
Default_Priority : constant Priority :=
|
||||||
|
(Priority'Last - Priority'First) / 2;
|
||||||
|
|
||||||
|
private
|
||||||
|
|
||||||
|
type Address is mod Memory_Size;
|
||||||
|
Null_Address : constant Address := 0;
|
||||||
|
|
||||||
|
--------------------------------------
|
||||||
|
-- System Implementation Parameters --
|
||||||
|
--------------------------------------
|
||||||
|
|
||||||
|
-- These parameters provide information about the target that is used
|
||||||
|
-- by the compiler. They are in the private part of System, where they
|
||||||
|
-- can be accessed using the special circuitry in the Targparm unit
|
||||||
|
-- whose source should be consulted for more detailed descriptions
|
||||||
|
-- of the individual switch values.
|
||||||
|
|
||||||
|
AAMP : constant Boolean := False;
|
||||||
|
Backend_Divide_Checks : constant Boolean := False;
|
||||||
|
Backend_Overflow_Checks : constant Boolean := False;
|
||||||
|
Command_Line_Args : constant Boolean := True;
|
||||||
|
Configurable_Run_Time : constant Boolean := False;
|
||||||
|
Denorm : constant Boolean := True;
|
||||||
|
Duration_32_Bits : constant Boolean := False;
|
||||||
|
Exit_Status_Supported : constant Boolean := True;
|
||||||
|
Fractional_Fixed_Ops : constant Boolean := False;
|
||||||
|
Frontend_Layout : constant Boolean := False;
|
||||||
|
Functions_Return_By_DSP : constant Boolean := False;
|
||||||
|
Machine_Overflows : constant Boolean := False;
|
||||||
|
Machine_Rounds : constant Boolean := True;
|
||||||
|
OpenVMS : constant Boolean := False;
|
||||||
|
Signed_Zeros : constant Boolean := True;
|
||||||
|
Stack_Check_Default : constant Boolean := False;
|
||||||
|
Stack_Check_Probes : constant Boolean := False;
|
||||||
|
Support_64_Bit_Divides : constant Boolean := True;
|
||||||
|
Support_Aggregates : constant Boolean := True;
|
||||||
|
Support_Composite_Assign : constant Boolean := True;
|
||||||
|
Support_Composite_Compare : constant Boolean := True;
|
||||||
|
Support_Long_Shifts : constant Boolean := True;
|
||||||
|
Suppress_Standard_Library : constant Boolean := False;
|
||||||
|
Use_Ada_Main_Program_Name : constant Boolean := False;
|
||||||
|
ZCX_By_Default : constant Boolean := False;
|
||||||
|
GCC_ZCX_Support : constant Boolean := False;
|
||||||
|
Front_End_ZCX_Support : constant Boolean := False;
|
||||||
|
|
||||||
|
-- Obsolete entries, to be removed eventually (bootstrap issues!)
|
||||||
|
|
||||||
|
-- High_Integrity_Mode : constant Boolean := False;
|
||||||
|
-- Long_Shifts_Inlined : constant Boolean := True;
|
||||||
|
|
||||||
|
end System;
|
Loading…
Reference in New Issue