Remove old Ada compilers, as agreed upon quite some time back.
This commit is contained in:
dholland
parent
53b266c8db
commit
8ce7814a9a
45 changed files with 1 additions and 12160 deletions
|
|
@ -1,4 +1,4 @@
|
|||
# $NetBSD: Makefile,v 1.338 2012/12/29 19:41:17 dholland Exp $
|
||||
# $NetBSD: Makefile,v 1.339 2012/12/29 19:48:52 dholland Exp $
|
||||
#
|
||||
|
||||
COMMENT= Programming languages
|
||||
|
|
@ -52,13 +52,11 @@ SUBDIR+= gawk
|
|||
SUBDIR+= gcc
|
||||
SUBDIR+= gcc-aux
|
||||
SUBDIR+= gcc3
|
||||
SUBDIR+= gcc3-ada
|
||||
SUBDIR+= gcc3-c
|
||||
SUBDIR+= gcc3-c++
|
||||
SUBDIR+= gcc3-f77
|
||||
SUBDIR+= gcc3-objc
|
||||
SUBDIR+= gcc34
|
||||
SUBDIR+= gcc34-ada
|
||||
SUBDIR+= gcc44
|
||||
SUBDIR+= gcc45
|
||||
SUBDIR+= gcc46
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
The GNU Compiler Collection (GCC) version 3.x.
|
||||
|
||||
This package includes support for compiling the Ada language.
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
===========================================================================
|
||||
$NetBSD: MESSAGE,v 1.1 2003/12/08 18:33:52 drochner Exp $
|
||||
|
||||
To use ${PKGNAME} include "${GCC_PREFIX}/mk/ada.mk" in your
|
||||
BSD style makefile.
|
||||
|
||||
===========================================================================
|
||||
|
|
@ -1,90 +0,0 @@
|
|||
# $NetBSD: Makefile,v 1.18 2012/08/14 17:07:57 asau Exp $
|
||||
|
||||
PKGNAME= gcc3${GCC3_PKGMODIF}-ada-${GCC_VERSION}
|
||||
COMMENT= GNU Compiler Collection, v3 - Ada compiler
|
||||
|
||||
PKG_DESTDIR_SUPPORT= none
|
||||
|
||||
.include "../../lang/gcc3/language.mk"
|
||||
|
||||
PTHREAD_OPTS+= require native
|
||||
CONFIGURE_ARGS+= --enable-languages="ada"
|
||||
CONFIGURE_ARGS+= --enable-threads=yes
|
||||
|
||||
#
|
||||
# Bootstrap section. Define something to make the package usable.
|
||||
#
|
||||
# To make things more interesting, we need an existing GCC with Ada
|
||||
# support to build Ada support.
|
||||
#
|
||||
# A gcc tree with compiler driver and gnatbind should be in ADA_BOOT_PATH.
|
||||
#
|
||||
#ADA_BOOT_PATH= /path/to/adagcc
|
||||
#
|
||||
# Use this if a special compiler driver is needed to compile Ada programs
|
||||
# (as seen in Linux installations).
|
||||
#
|
||||
#GNATGCC_ADA_DRIVER= gnatgcc
|
||||
|
||||
.if defined(ADA_BOOT_PATH)
|
||||
. if defined(GNATGCC_ADA_DRIVER)
|
||||
ADA_BOOT_ADAC= ${ADA_BOOT_PATH}/bin/${GNATGCC_ADA_DRIVER}
|
||||
. else
|
||||
ADA_BOOT_ADAC= ${ADA_BOOT_PATH}/bin/gcc
|
||||
. endif
|
||||
ADA_BOOT_GNATBIND= ${ADA_BOOT_PATH}/bin/gnatbind
|
||||
|
||||
EXTRA_ENV+= ADAC=${ADA_BOOT_ADAC:Q}
|
||||
CONFIGURE_ENV+= ${EXTRA_ENV}
|
||||
MAKE_ENV+= ${EXTRA_ENV}
|
||||
|
||||
.else # !ADA_BOOT_PATH
|
||||
|
||||
PKG_SKIP_REASON= "Sorry, need an Ada compiler"
|
||||
|
||||
.endif # ADA_BOOT_PATH
|
||||
|
||||
#
|
||||
# End of bootstrap section
|
||||
#
|
||||
|
||||
post-patch:
|
||||
cd ${FILESDIR}; \
|
||||
${CP} adasignal.c ${WRKSRC}/gcc/ada; \
|
||||
${CP} ada_lwp_self.c ${WRKSRC}/gcc/ada; \
|
||||
for i in *.adb *.ads ; do \
|
||||
${CP} $$i ${WRKSRC}/gcc/ada; \
|
||||
done
|
||||
|
||||
post-wrapper:
|
||||
${LN} -sf ${ADA_BOOT_GNATBIND} ${BUILDLINK_DIR}/bin
|
||||
|
||||
post-configure:
|
||||
${TEST} -f ${WRKSRC}/gcc/ada/Makefile \
|
||||
|| ${FALSE} # no ada bootstrap found by configure
|
||||
cd ${WRKSRC}/gcc/ada && ${TOUCH} treeprs.ads [es]info.h nmake.ad[bs]
|
||||
|
||||
do-build:
|
||||
cd ${WRKSRC}/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} ada
|
||||
# XXX avoid some VPATH related lossage
|
||||
cd ${WRKSRC}/gcc/ada && ${MV} targtyps.o targtyps.o.sav
|
||||
cd ${WRKSRC}/gcc/ada && ${RM} -f *.o *.ali
|
||||
cd ${WRKSRC}/gcc/ada && ${MV} targtyps.o.sav targtyps.o
|
||||
cd ${WRKSRC}/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} gnatlib_and_tools
|
||||
|
||||
post-build:
|
||||
@${SED} ${FILES_SUBST_SED} ${FILESDIR}/gcc3.mk > ${WRKDIR}/gcc3.mk
|
||||
${ECHO} "ADA_INCLUDE_PATH+=${GCC_ARCHDIR}/adainclude" >> ${WRKDIR}/gcc3.mk
|
||||
|
||||
do-install:
|
||||
${INSTALL_PROGRAM_DIR} ${GCC_ARCHDIR}
|
||||
${INSTALL_PROGRAM} ${WRKSRC}/gcc/gnat1 ${GCC_ARCHDIR}
|
||||
cd ${WRKSRC}/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} \
|
||||
ada.install-common ada.install-info install-gnatlib
|
||||
${RM} -f ${GCC_ARCHDIR}/adalib/lib*.so
|
||||
|
||||
post-install:
|
||||
${INSTALL_DATA} ${WRKDIR}/gcc3.mk ${GCC_PREFIX}/mk/ada.mk
|
||||
|
||||
.include "../../mk/pthread.buildlink3.mk"
|
||||
.include "../../mk/bsd.pkg.mk"
|
||||
1104
lang/gcc3-ada/PLIST
1104
lang/gcc3-ada/PLIST
File diff suppressed because it is too large
Load diff
|
|
@ -1,32 +0,0 @@
|
|||
# $NetBSD: buildlink3.mk,v 1.9 2009/03/20 19:24:49 joerg Exp $
|
||||
|
||||
BUILDLINK_PREFIX.gcc3-ada:=${LOCALBASE}/gcc3
|
||||
|
||||
BUILDLINK_TREE+= gcc3-ada
|
||||
|
||||
.if !defined(GCC3_ADA_BUILDLINK3_MK)
|
||||
GCC3_ADA_BUILDLINK3_MK:=
|
||||
|
||||
BUILDLINK_API_DEPENDS.gcc3-ada+= gcc3-ada>=3.3.3
|
||||
BUILDLINK_ABI_DEPENDS.gcc3-ada?= gcc3-ada>=3.3.5nb1
|
||||
BUILDLINK_PKGSRCDIR.gcc3-ada?= ../../lang/gcc3-ada
|
||||
BUILDLINK_ENV+= ADAC=${LOCALBASE}/gcc3/bin/gcc
|
||||
_GCC_ARCHDIR!= ${DIRNAME} `${LOCALBASE}/gcc3/bin/gcc --print-libgcc-file-name`
|
||||
. if empty(_GCC_ARCHDIR:M*not_found*)
|
||||
BUILDLINK_LIBDIRS.gcc3-ada+= lib ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc3-ada}\///}
|
||||
BUILDLINK_LIBDIRS.gcc3-ada+= ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc3-ada}\///}/adalib
|
||||
BUILDLINK_INCDIRS.gcc3-ada+= include ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc3-ada}\///}/adainclude
|
||||
. endif
|
||||
|
||||
BUILDLINK_PKGSRCDIR.gcc3-ada?= ../../lang/gcc3-ada
|
||||
BUILDLINK_FILES_CMD.gcc3-ada= (cd ${BUILDLINK_PREFIX.gcc3-ada} && \
|
||||
${FIND} bin libexec lib \( -type file -o -type link \) -print)
|
||||
BUILDLINK_FNAME_TRANSFORM.gcc3-ada= -e s:\buildlink:buildlink/gcc3:
|
||||
|
||||
BUILDLINK_DEPMETHOD.gcc3-ada?= build
|
||||
|
||||
.include "../../mk/pthread.buildlink3.mk"
|
||||
.include "../../converters/libiconv/buildlink3.mk"
|
||||
.endif # GCC3_ADA_BUILDLINK3_MK
|
||||
|
||||
BUILDLINK_TREE+= -gcc3-ada
|
||||
|
|
@ -1,117 +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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is a NetBSD version of this package.
|
||||
--
|
||||
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 := System.OS_Interface.sigabrt;
|
||||
-- used by abort,-- 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 := System.OS_Interface.sigpipe;
|
||||
-- write on a pipe with-- 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
|
||||
Sigcld : constant Interrupt_ID := System.OS_Interface.sigchld;
|
||||
-- child status change
|
||||
Sigchld : constant Interrupt_ID := System.OS_Interface.sigchld;
|
||||
-- 4.3BSD's/POSIX name for SIGCLD
|
||||
Sigwinch : constant Interrupt_ID := System.OS_Interface.sigwinch;
|
||||
-- window size change
|
||||
Sigurg : constant Interrupt_ID := System.OS_Interface.sigurg;
|
||||
-- urgent condition on IO channel
|
||||
Sigpoll : constant Interrupt_ID := System.OS_Interface.sigio;
|
||||
-- pollable event occurred
|
||||
Sigio : constant Interrupt_ID := System.OS_Interface.sigio;
|
||||
-- input/output possible,-- SIGPOLL alias (Solaris)
|
||||
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
|
||||
Sigttin : constant Interrupt_ID := System.OS_Interface.sigttin;
|
||||
-- background tty read attempted
|
||||
Sigttou : constant Interrupt_ID := System.OS_Interface.sigttou;
|
||||
-- background tty write attempted
|
||||
Sigvtalrm : constant Interrupt_ID := System.OS_Interface.sigvtalrm;
|
||||
-- virtual timer expired
|
||||
Sigprof : constant Interrupt_ID := System.OS_Interface.sigprof;
|
||||
-- profiling timer expired
|
||||
Sigxcpu : constant Interrupt_ID := System.OS_Interface.sigxcpu;
|
||||
-- CPU time limit exceeded
|
||||
Sigxfsz : constant Interrupt_ID := System.OS_Interface.sigxfsz;
|
||||
-- filesize limit exceeded
|
||||
Sigpwr : constant Interrupt_ID := System.OS_Interface.sigpwr;
|
||||
-- power-fail restart
|
||||
Siginfo : constant Interrupt_ID := System.OS_Interface.siginfo;
|
||||
|
||||
end Ada.Interrupts.Names;
|
||||
|
|
@ -1,101 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1992-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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is a NetBSD version of this package.
|
||||
|
||||
-- PLEASE DO NOT add any dependences on other packages.
|
||||
-- This package is designed to work with or without tasking support.
|
||||
|
||||
-- Make a careful study of all signals available under the OS,
|
||||
-- to see which need to be reserved, kept always unmasked,
|
||||
-- or kept always unmasked.
|
||||
|
||||
-- Be on the lookout for special signals that
|
||||
-- may be used by the thread library.
|
||||
|
||||
with Interfaces.C;
|
||||
-- used for int
|
||||
|
||||
with System.OS_Interface;
|
||||
-- used for various Constants, Signal and types
|
||||
|
||||
package body System.Interrupt_Management is
|
||||
|
||||
use Interfaces.C;
|
||||
use System.OS_Interface;
|
||||
|
||||
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
|
||||
|
||||
Exception_Interrupts : constant Interrupt_List :=
|
||||
(sigfpe, sigill, sigsegv, sigbus);
|
||||
|
||||
Unreserve_All_Interrupts : Interfaces.C.int;
|
||||
pragma Import
|
||||
(C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
|
||||
|
||||
-- Nothing needs to be done on this platform.
|
||||
|
||||
procedure Initialize_Interrupts is
|
||||
begin
|
||||
null;
|
||||
end Initialize_Interrupts;
|
||||
|
||||
use type Interfaces.C.int;
|
||||
|
||||
begin
|
||||
|
||||
Abort_Task_Interrupt := sigabrt;
|
||||
-- Change this if you want to use another signal for task abort.
|
||||
-- SIGTERM might be a good one.
|
||||
|
||||
for I in Exception_Interrupts'Range loop
|
||||
Keep_Unmasked (Exception_Interrupts (I)) := True;
|
||||
end loop;
|
||||
|
||||
-- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but in the
|
||||
-- same time, disable the ability of handling this signal via
|
||||
-- Ada.Interrupts.
|
||||
-- The pragma Unreserve_All_Interrupts let the user the ability to
|
||||
-- change this behavior.
|
||||
|
||||
if Unreserve_All_Interrupts = 0 then
|
||||
Keep_Unmasked (sigint) := True;
|
||||
end if;
|
||||
|
||||
Keep_Unmasked (Abort_Task_Interrupt) := True;
|
||||
|
||||
Reserve := Keep_Unmasked or Keep_Masked;
|
||||
Reserve (0) := True;
|
||||
|
||||
end System.Interrupt_Management;
|
||||
|
|
@ -1,144 +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-2001 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 the NetBSD 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
|
||||
|
||||
------------------
|
||||
-- pthread_init --
|
||||
------------------
|
||||
|
||||
procedure pthread_init is
|
||||
begin
|
||||
null;
|
||||
end pthread_init;
|
||||
|
||||
function pthread_mutexattr_setprotocol
|
||||
(attr : access pthread_mutexattr_t;
|
||||
protocol : int)
|
||||
return int
|
||||
is
|
||||
begin
|
||||
return 0;
|
||||
end pthread_mutexattr_setprotocol;
|
||||
|
||||
function pthread_mutexattr_setprioceiling
|
||||
(attr : access pthread_mutexattr_t;
|
||||
prioceiling : int)
|
||||
return int
|
||||
is
|
||||
begin
|
||||
return 0;
|
||||
end pthread_mutexattr_setprioceiling;
|
||||
|
||||
function pthread_setschedparam
|
||||
(thread : pthread_t;
|
||||
policy : int;
|
||||
param : access struct_sched_param)
|
||||
return int
|
||||
is
|
||||
begin
|
||||
-- Dummy until function is included in run-time
|
||||
return 0;
|
||||
end pthread_setschedparam;
|
||||
|
||||
-----------------
|
||||
-- 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;
|
||||
|
||||
function To_Timeval (D : Duration) return struct_timeval 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 struct_timeval' (tv_sec => S,
|
||||
tv_usec => time_t (Long_Long_Integer (F * 10#1#E6)));
|
||||
end To_Timeval;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
|
@ -1,620 +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-2001 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 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;
|
||||
|
||||
pragma Linker_Options ("-lposix");
|
||||
pragma Linker_Options ("-lpthread");
|
||||
|
||||
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");
|
||||
|
||||
EPERM : constant := 1; -- Operation not permitted
|
||||
ENOENT : constant := 2; -- No such file or directory
|
||||
ESRCH : constant := 3; -- No such process
|
||||
EINTR : constant := 4; -- Interrupted system call
|
||||
EIO : constant := 5; -- Input/output error
|
||||
ENXIO : constant := 6; -- Device not configured
|
||||
E2BIG : constant := 7; -- Argument list too long
|
||||
ENOEXEC : constant := 8; -- Exec format error
|
||||
EBADF : constant := 9; -- Bad file descriptor
|
||||
ECHILD : constant := 10; -- No child processes
|
||||
EDEADLK : constant := 11; -- Resource deadlock avoided
|
||||
ENOMEM : constant := 12; -- Cannot allocate memory
|
||||
EACCES : constant := 13; -- Permission denied
|
||||
EFAULT : constant := 14; -- Bad address
|
||||
ENOTBLK : constant := 15; -- Block device required
|
||||
EBUSY : constant := 16; -- Device busy
|
||||
EEXIST : constant := 17; -- File exists
|
||||
EXDEV : constant := 18; -- Cross-device link
|
||||
ENODEV : constant := 19;
|
||||
ENOTDIR : constant := 20; -- Not a directory
|
||||
EISDIR : constant := 21; -- Is a directory
|
||||
EINVAL : constant := 22; -- Invalid argument
|
||||
ENFILE : constant := 23;
|
||||
EMFILE : constant := 24; -- Too many open files
|
||||
ENOTTY : constant := 25;
|
||||
ETXTBSY : constant := 26; -- Text file busy
|
||||
EFBIG : constant := 27; -- File too large
|
||||
ENOSPC : constant := 28; -- No space left on device
|
||||
ESPIPE : constant := 29; -- Illegal seek
|
||||
EROFS : constant := 30; -- Read-only file system
|
||||
EMLINK : constant := 31; -- Too many links
|
||||
EPIPE : constant := 32; -- Broken pipe
|
||||
EDOM : constant := 33;
|
||||
ERANGE : constant := 34;
|
||||
EAGAIN : constant := 35;
|
||||
EWOULDBLOCK : constant := EAGAIN; -- Operation would block
|
||||
EINPROGRESS : constant := 36; -- Operation now in progress
|
||||
EALREADY : constant := 37;
|
||||
ENOTSOCK : constant := 38;
|
||||
EDESTADDRREQ : constant := 39;
|
||||
EMSGSIZE : constant := 40; -- Message too long
|
||||
EPROTOTYPE : constant := 41;
|
||||
ENOPROTOOPT : constant := 42; -- Protocol not available
|
||||
EPROTONOSUPPORT : constant := 43; -- Protocol not supported
|
||||
ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported
|
||||
EOPNOTSUPP : constant := 45; -- Operation not supported
|
||||
EPFNOSUPPORT : constant := 46;
|
||||
EAFNOSUPPORT : constant := 47;
|
||||
EADDRINUSE : constant := 48; -- Address already in use
|
||||
EADDRNOTAVAIL : constant := 49;
|
||||
ENETDOWN : constant := 50; -- Network is down
|
||||
ENETUNREACH : constant := 51; -- Network is unreachable
|
||||
ENETRESET : constant := 52;
|
||||
ECONNABORTED : constant := 53;
|
||||
ECONNRESET : constant := 54; -- Connection reset by peer
|
||||
ENOBUFS : constant := 55; -- No buffer space available
|
||||
EISCONN : constant := 56;
|
||||
ENOTCONN : constant := 57; -- Socket is not connected
|
||||
ESHUTDOWN : constant := 58;
|
||||
ETOOMANYREFS : constant := 59;
|
||||
ETIMEDOUT : constant := 60; -- Operation timed out
|
||||
ECONNREFUSED : constant := 61; -- Connection refused
|
||||
ELOOP : constant := 62;
|
||||
ENAMETOOLONG : constant := 63; -- File name too long
|
||||
EHOSTDOWN : constant := 64; -- Host is down
|
||||
EHOSTUNREACH : constant := 65; -- No route to host
|
||||
ENOTEMPTY : constant := 66; -- Directory not empty
|
||||
EPROCLIM : constant := 67; -- Too many processes
|
||||
EUSERS : constant := 68; -- Too many users
|
||||
EDQUOT : constant := 69; -- Disc quota exceeded
|
||||
ESTALE : constant := 70; -- Stale NFS file handle
|
||||
EREMOTE : constant := 71;
|
||||
EBADRPC : constant := 72; -- RPC struct is bad
|
||||
ERPCMISMATCH : constant := 73; -- RPC version wrong
|
||||
EPROGUNAVAIL : constant := 74; -- RPC prog. not avail
|
||||
EPROGMISMATCH : constant := 75; -- Program version wrong
|
||||
EPROCUNAVAIL : constant := 76; -- Bad procedure for program
|
||||
ENOLCK : constant := 77; -- No locks available
|
||||
ENOSYS : constant := 78; -- Function not implemented
|
||||
EFTYPE : constant := 79;
|
||||
EAUTH : constant := 80; -- Authentication error
|
||||
ENEEDAUTH : constant := 81; -- Need authenticator
|
||||
EIDRM : constant := 82; -- Identifier removed
|
||||
ENOMSG : constant := 83; -- No message of desired type
|
||||
EOVERFLOW : constant := 84;
|
||||
EILSEQ : constant := 85; -- Illegal byte sequence
|
||||
ENOTSUP : constant := 86; -- Not supported
|
||||
ECANCELED : constant := 87; -- Operation canceled
|
||||
EBADMSG : constant := 88; -- Bad or Corrupt message
|
||||
ENODATA : constant := 89; -- No message available
|
||||
ENOSR : constant := 90; -- No STREAM resources
|
||||
ENOSTR : constant := 91; -- Not a STREAM
|
||||
ETIME : constant := 92; -- STREAM ioctl timeout
|
||||
ELAST : constant := 92; -- Must equal largest errno
|
||||
|
||||
-------------
|
||||
-- Signals --
|
||||
-------------
|
||||
Max_Interrupt : constant := 64;
|
||||
type Signal is new int range 0 .. Max_Interrupt;
|
||||
for Signal'Size use int'Size;
|
||||
|
||||
sighup : constant := 1; -- hangup
|
||||
sigint : constant := 2; -- interrupt
|
||||
sigquit : constant := 3; -- quit
|
||||
sigill : constant := 4; -- illegal instruction (not reset when caught)
|
||||
sigtrap : constant := 5; -- trace trap (not reset when caught)
|
||||
sigabrt : constant := 6; -- abort()
|
||||
sigiot : constant := sigabrt; -- compatibility
|
||||
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; -- sendable stop signal not from tty
|
||||
sigtstp : constant := 18; -- stop signal from tty
|
||||
sigcont : constant := 19; -- continue a stopped process
|
||||
sigchld : constant := 20; -- to parent on child stop or exit
|
||||
sigttin : constant := 21; -- to readers pgrp upon background tty read
|
||||
sigttou : constant := 22; -- like TTIN for output if (tp->t_local<OSTOP)
|
||||
sigio : constant := 23; -- input/output possible signal
|
||||
sigxcpu : constant := 24; -- exceeded CPU time limit
|
||||
sigxfsz : constant := 25; -- exceeded file size limit
|
||||
sigvtalrm : constant := 26; -- virtual time alarm
|
||||
sigprof : constant := 27; -- profiling time alarm
|
||||
sigwinch : constant := 28; -- window size changes
|
||||
siginfo : constant := 29; -- information request
|
||||
sigusr1 : constant := 30; -- user defined signal 1
|
||||
sigusr2 : constant := 31; -- user defined signal 2
|
||||
sigpwr : constant := 32; -- power fail/restart (not reset when caught)
|
||||
sigwaiting : constant := 0; -- process's lwps blocked (Solaris)
|
||||
sigcancel : constant := 0; -- thread cancellation signal (libthread)
|
||||
|
||||
type signal_set is array (Natural range <>) of Signal;
|
||||
|
||||
Unmasked : constant signal_set := (sigkill, sigill, sigprof, sigtrap,
|
||||
sigpwr);
|
||||
|
||||
-- Following signals should not be disturbed.
|
||||
-- See c-posix-signals.c in FLORIST
|
||||
Reserved : constant signal_set := (sigalrm, sigbus, sigill, sigsegv,
|
||||
sigfpe, sigabrt, sigkill, sigstop);
|
||||
|
||||
-- PTHREAD_SIGMASK(3)
|
||||
SIG_BLOCK : constant := 1;
|
||||
SIG_SETMASK : constant := 3;
|
||||
SIG_UNBLOCK : constant := 2;
|
||||
|
||||
type sigset_t is private;
|
||||
type sigset_t_ptr is access all sigset_t;
|
||||
|
||||
-- Binding to macros defined in <signal.h>
|
||||
function sigaddset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigaddset, "adasigaddset");
|
||||
|
||||
function sigdelset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigdelset, "adasigdelset");
|
||||
|
||||
function sigfillset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigfillset, "adasigfillset");
|
||||
|
||||
function sigismember (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigismember, "adasigismember");
|
||||
|
||||
function sigemptyset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigemptyset, "adasigemptyset");
|
||||
|
||||
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_DFL : constant := 0;
|
||||
SIG_IGN : constant := 1;
|
||||
|
||||
function sigaction
|
||||
(sig : Signal;
|
||||
act : struct_sigaction_ptr;
|
||||
oact : struct_sigaction_ptr := null) return int;
|
||||
pragma Import (C, sigaction, "adasigaction");
|
||||
|
||||
----------
|
||||
-- Time --
|
||||
----------
|
||||
|
||||
type clockid_t is new int;
|
||||
CLOCK_REALTIME : constant := 0;
|
||||
|
||||
type timespec is private;
|
||||
|
||||
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);
|
||||
|
||||
function Gettimeofday (
|
||||
Tv : access Struct_Timeval;
|
||||
Tz : System.Address := System.Null_Address)
|
||||
return int;
|
||||
pragma Import (C, Gettimeofday, "gettimeofday");
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
pragma Import (C, clock_gettime, "clock_gettime");
|
||||
|
||||
|
||||
---------
|
||||
-- LWP --
|
||||
---------
|
||||
|
||||
type lwpid_t is new long;
|
||||
|
||||
function lwp_self return System.Address;
|
||||
pragma Import (C, lwp_self, "ada_lwp_self");
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Priority Scheduling --
|
||||
-------------------------
|
||||
|
||||
SCHED_FIFO : constant := 1;
|
||||
SCHED_RR : constant := 2;
|
||||
SCHED_TS : constant := 3;
|
||||
SCHED_OTHER : constant := 3;
|
||||
SCHED_NP : constant := 4;
|
||||
|
||||
function sched_get_priority_min (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_min, "sched_get_priority_min");
|
||||
|
||||
function sched_get_priority_max (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_max, "sched_get_priority_max");
|
||||
|
||||
-------------
|
||||
-- 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");
|
||||
|
||||
-------------
|
||||
-- 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;
|
||||
subtype cond_t is pthread_cond_t;
|
||||
|
||||
PTHREAD_CREATE_DETACHED : constant := 1;
|
||||
|
||||
---------------------------------------
|
||||
-- Nonstandard Thread Initialization --
|
||||
---------------------------------------
|
||||
|
||||
procedure pthread_init;
|
||||
pragma Inline (pthread_init);
|
||||
-- This is a dummy procedure to share some GNULLI files
|
||||
|
||||
-------------------------
|
||||
-- POSIX.1c Section 3 --
|
||||
-------------------------
|
||||
|
||||
function sigwait
|
||||
(set : access sigset_t;
|
||||
sig : access Signal) return int;
|
||||
pragma Import (C, sigwait, "adasigwait");
|
||||
|
||||
function pthread_kill
|
||||
(thread : pthread_t;
|
||||
sig : Signal) return int;
|
||||
pragma Import (C, pthread_kill, "pthread_kill");
|
||||
|
||||
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");
|
||||
|
||||
--------------------------
|
||||
-- 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;
|
||||
|
||||
function pthread_mutexattr_setprioceiling
|
||||
(attr : access pthread_mutexattr_t;
|
||||
prioceiling : int) return int;
|
||||
|
||||
type struct_sched_param is record
|
||||
sched_priority : int;
|
||||
end record;
|
||||
for struct_sched_param use record
|
||||
sched_priority at 0 range 0 .. 31;
|
||||
end record;
|
||||
pragma Convention (C, struct_sched_param);
|
||||
|
||||
function pthread_setschedparam
|
||||
(thread : pthread_t;
|
||||
policy : int;
|
||||
param : access struct_sched_param)
|
||||
return int;
|
||||
-- Does not exist yet - we provide a dummy
|
||||
-- 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);
|
||||
|
||||
function pthread_attr_setschedparam
|
||||
(attr : access pthread_attr_t;
|
||||
sched_param : access struct_sched_param)
|
||||
return int;
|
||||
pragma Import (C, pthread_attr_setschedparam, "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");
|
||||
|
||||
---------------------------------------------------------------
|
||||
-- Non portable SGI 6.5 additions to the pthread interface --
|
||||
-- must be executed from within the context of a system --
|
||||
-- scope task --
|
||||
---------------------------------------------------------------
|
||||
|
||||
function pthread_setrunon_np (cpu : int) return int;
|
||||
pragma Import (C, pthread_setrunon_np, "pthread_setrunon_np");
|
||||
|
||||
private
|
||||
|
||||
type array_type_1 is array (Integer range 0 .. 3) of unsigned;
|
||||
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;
|
||||
for timespec use record
|
||||
tv_sec at 0 range 0 .. 31;
|
||||
tv_nsec at 4 range 0 .. 31;
|
||||
end record;
|
||||
pragma Convention (C, timespec);
|
||||
|
||||
type struct_timeval is record
|
||||
tv_sec : time_t;
|
||||
tv_usec : time_t;
|
||||
end record;
|
||||
pragma Convention (C, struct_timeval);
|
||||
|
||||
type array_type_9 is array (Integer range 0 .. 4) of long;
|
||||
type pthread_attr_t is record
|
||||
X_X_D : array_type_9;
|
||||
end record;
|
||||
pragma Convention (C, pthread_attr_t);
|
||||
|
||||
type array_type_8 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_condattr_t is record
|
||||
X_X_D : array_type_8;
|
||||
end record;
|
||||
pragma Convention (C, pthread_condattr_t);
|
||||
|
||||
type array_type_7 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_mutexattr_t is record
|
||||
X_X_D : array_type_7;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutexattr_t);
|
||||
|
||||
type pthread_t is new unsigned;
|
||||
|
||||
type array_type_10 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_mutex_t is record
|
||||
X_X_D : array_type_10;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutex_t);
|
||||
|
||||
type array_type_11 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_cond_t is record
|
||||
X_X_D : array_type_11;
|
||||
end record;
|
||||
pragma Convention (C, pthread_cond_t);
|
||||
|
||||
type pthread_key_t is new int;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
|
@ -1,79 +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) 1998-2001 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 Solaris (native) specific version
|
||||
|
||||
package body System.Parameters is
|
||||
|
||||
------------------------
|
||||
-- Default_Stack_Size --
|
||||
------------------------
|
||||
|
||||
function Default_Stack_Size return Size_Type is
|
||||
begin
|
||||
return 8318976;
|
||||
end Default_Stack_Size;
|
||||
|
||||
------------------------
|
||||
-- Minimum_Stack_Size --
|
||||
------------------------
|
||||
|
||||
function Minimum_Stack_Size return Size_Type is
|
||||
|
||||
thr_min_stack : constant Size_Type := 1160;
|
||||
-- This value does not really matter anyway, since this is checked
|
||||
-- and adjusted at the library level when creating a thread.
|
||||
|
||||
begin
|
||||
return thr_min_stack;
|
||||
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;
|
||||
|
|
@ -1,139 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- (Default Version) --
|
||||
-- --
|
||||
-- $Revision: 1.1 $
|
||||
-- --
|
||||
-- Copyright (C) 1992-2000 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. --
|
||||
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
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 := 1.0;
|
||||
|
||||
-- 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 := Low_Order_First;
|
||||
|
||||
-- Priority-related Declarations (RM D.1)
|
||||
|
||||
Max_Priority : constant Positive := 30;
|
||||
Max_Interrupt_Priority : constant Positive := 31;
|
||||
|
||||
subtype Any_Priority is Integer range 0 .. 31;
|
||||
subtype Priority is Any_Priority range 0 .. 30;
|
||||
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
|
||||
|
||||
Default_Priority : constant Priority := 15;
|
||||
|
||||
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;
|
||||
Denorm : constant Boolean := True;
|
||||
Fractional_Fixed_Ops : constant Boolean := False;
|
||||
Frontend_Layout : constant Boolean := False;
|
||||
Functions_Return_By_DSP : constant Boolean := False;
|
||||
Long_Shifts_Inlined : constant Boolean := True;
|
||||
High_Integrity_Mode : 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;
|
||||
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;
|
||||
end System;
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,143 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . T A S K _ I N F O --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2000 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 package contains the definitions and routines associated with the
|
||||
-- implementation of the Task_Info pragma.
|
||||
|
||||
-- This is the NetBSD (native) version of this module.
|
||||
|
||||
with System.OS_Interface;
|
||||
with Unchecked_Deallocation;
|
||||
package System.Task_Info is
|
||||
pragma Elaborate_Body;
|
||||
-- To ensure that a body is allowed
|
||||
|
||||
-----------------------------------------------------
|
||||
-- Binding of Tasks to LWPs and LWPs to processors --
|
||||
-----------------------------------------------------
|
||||
|
||||
-- The NetBSD implementation of the GNU Low-Level Interface (GNULLI)
|
||||
-- implements each Ada task as a NetBSD thread. The NetBSD thread
|
||||
-- library distributes threads across one or more LWPs (Light Weight
|
||||
-- Process) that are members of the same process. NetBSD distributes
|
||||
-- processes and LWPs across the available CPUs on a given machine. The
|
||||
-- pragma Task_Info provides the mechanism to control the distribution
|
||||
-- of tasks to LWPs, and LWPs to processors.
|
||||
|
||||
-- Each thread has a number of attributes that dictate it's scheduling.
|
||||
-- These attributes are:
|
||||
--
|
||||
-- New_LWP: whether a new LWP is created for this thread.
|
||||
--
|
||||
-- Bound_To_LWP: whether the thread is bound to a specific LWP
|
||||
-- for its entire lifetime.
|
||||
--
|
||||
-- CPU: the CPU number associated to the LWP
|
||||
--
|
||||
|
||||
-- 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 Task_Info_Unspecified 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_Number is System.OS_Interface.processorid_t;
|
||||
|
||||
CPU_UNCHANGED : constant CPU_Number := System.OS_Interface.PBIND_QUERY;
|
||||
-- Do not bind the LWP to a specific processor
|
||||
|
||||
ANY_CPU : constant CPU_Number := System.OS_Interface.PBIND_NONE;
|
||||
-- Bind the LWP to any processor
|
||||
|
||||
Invalid_CPU_Number : exception;
|
||||
|
||||
type Thread_Attributes (New_LWP : Boolean) is record
|
||||
Bound_To_LWP : Boolean := True;
|
||||
case New_LWP is
|
||||
when False =>
|
||||
null;
|
||||
when True =>
|
||||
CPU : CPU_Number := CPU_UNCHANGED;
|
||||
end case;
|
||||
end record;
|
||||
|
||||
Default_Thread_Attributes : constant Thread_Attributes := (False, True);
|
||||
|
||||
function Unbound_Thread_Attributes
|
||||
return Thread_Attributes;
|
||||
|
||||
function Bound_Thread_Attributes
|
||||
return Thread_Attributes;
|
||||
|
||||
function Bound_Thread_Attributes (CPU : CPU_Number)
|
||||
return Thread_Attributes;
|
||||
|
||||
type Task_Info_Type is access all Thread_Attributes;
|
||||
|
||||
function New_Unbound_Thread_Attributes
|
||||
return Task_Info_Type;
|
||||
|
||||
function New_Bound_Thread_Attributes
|
||||
return Task_Info_Type;
|
||||
|
||||
function New_Bound_Thread_Attributes (CPU : CPU_Number)
|
||||
return Task_Info_Type;
|
||||
|
||||
type Task_Image_Type is access String;
|
||||
-- Used to generate a meaningful identifier for tasks that are variables
|
||||
-- and components of variables.
|
||||
|
||||
procedure Free_Task_Image is new
|
||||
Unchecked_Deallocation (String, Task_Image_Type);
|
||||
|
||||
Unspecified_Task_Info : constant Task_Info_Type := null;
|
||||
|
||||
end System.Task_Info;
|
||||
|
|
@ -1,52 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1991-1998, 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 NetBSD/X86 (native) version of this package.
|
||||
|
||||
separate (System.Task_Primitives.Operations)
|
||||
|
||||
----------
|
||||
-- Self --
|
||||
----------
|
||||
|
||||
function Self return Task_ID is
|
||||
Temp : aliased System.Address;
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
begin
|
||||
Result := pthread_getspecific (ATCB_Key, Temp'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
return To_Task_ID (Temp);
|
||||
end Self;
|
||||
|
|
@ -1,89 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1991-2001, 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 NetBSD version of this package.
|
||||
|
||||
separate (System.Task_Primitives.Operations)
|
||||
package body Specific is
|
||||
|
||||
------------------
|
||||
-- Local Data --
|
||||
------------------
|
||||
|
||||
-- The followings are logically constants, but need to be initialized
|
||||
-- at run time.
|
||||
|
||||
ATCB_Key : aliased pthread_key_t;
|
||||
-- Key used to find the Ada Task_ID associated with a thread
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
procedure Initialize (Environment_Task : Task_ID) is
|
||||
Result : Interfaces.C.int;
|
||||
begin
|
||||
Result := pthread_key_create (ATCB_Key'Access, null);
|
||||
pragma Assert (Result = 0);
|
||||
Result := pthread_setspecific (ATCB_Key, To_Address (Environment_Task));
|
||||
pragma Assert (Result = 0);
|
||||
end Initialize;
|
||||
|
||||
---------
|
||||
-- Set --
|
||||
---------
|
||||
|
||||
procedure Set (Self_Id : Task_ID) is
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
begin
|
||||
Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id));
|
||||
pragma Assert (Result = 0);
|
||||
end Set;
|
||||
|
||||
----------
|
||||
-- Self --
|
||||
----------
|
||||
|
||||
function Self return Task_ID is
|
||||
Result : System.Address;
|
||||
|
||||
begin
|
||||
Result := pthread_getspecific (ATCB_Key);
|
||||
pragma Assert (Result /= System.Null_Address);
|
||||
return To_Task_ID (Result);
|
||||
end Self;
|
||||
|
||||
end Specific;
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
/* Binding to _lwp_self for the Ada RTS */
|
||||
#include <lwp.h>
|
||||
|
||||
lwpid_t ada_lwp_self(void) {
|
||||
return _lwp_self();
|
||||
}
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
#include <signal.h>
|
||||
|
||||
/* <signal.h> defines macros for a number of
|
||||
signal handling functions. Bindings are
|
||||
provided here, that expand the macros,
|
||||
for use by the Ada RTS. */
|
||||
|
||||
int adasigaddset(sigset_t *set, int signo) {
|
||||
return sigaddset(set, signo);
|
||||
}
|
||||
|
||||
int adasigdelset(sigset_t *set, int signo) {
|
||||
return sigdelset(set, signo);
|
||||
}
|
||||
|
||||
int adasigemptyset(sigset_t *set) {
|
||||
return sigemptyset(set);
|
||||
}
|
||||
|
||||
int adasigfillset(sigset_t *set) {
|
||||
return sigfillset(set);
|
||||
}
|
||||
|
||||
int adasigismember(sigset_t *set, int signo) {
|
||||
return sigismember(set, signo);
|
||||
}
|
||||
|
||||
int adasigaction(int sig, const struct sigaction *act, struct sigaction *oact) {
|
||||
return sigaction(sig, act, oact);
|
||||
}
|
||||
|
||||
int adasigwait(const sigset_t *set, int *sig) {
|
||||
return sigwait(set, sig);
|
||||
}
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
# $NetBSD: gcc3.mk,v 1.1 2003/12/08 18:33:53 drochner Exp $
|
||||
#
|
||||
# make configuration file for @PKGNAME@
|
||||
|
||||
CC= @GCC_PREFIX@/bin/cc
|
||||
CPP= @GCC_PREFIX@/bin/cpp
|
||||
CXX= @GCC_PREFIX@/bin/c++
|
||||
ADAC= @GCC_PREFIX@/bin/gcc
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
This is the Ada compiler from the gcc 3.4 compiler suite.
|
||||
|
||||
This package has a test target. For testing (only), this
|
||||
package requires dejagnu. As part of the tests, acats
|
||||
(the Ada compiler validation suite) is run.
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
===========================================================================
|
||||
$NetBSD: MESSAGE,v 1.2 2005/09/28 14:15:49 rillig Exp $
|
||||
|
||||
A wrapper, "ada", has been placed in ${LOCALBASE}/bin to setup the
|
||||
environment and call the tools in this package. So, to make a program
|
||||
with a main program file "main.adb" you would type:
|
||||
|
||||
ada gnatmake main.adb
|
||||
|
||||
===========================================================================
|
||||
|
|
@ -1,183 +0,0 @@
|
|||
# $NetBSD: Makefile,v 1.28 2012/08/14 17:07:57 asau Exp $
|
||||
#
|
||||
|
||||
DISTNAME= gcc-${GCC_VERSION}
|
||||
PKGNAME= gcc34-ada-${GCC_VERSION}
|
||||
PKGREVISION= 1
|
||||
CATEGORIES= lang
|
||||
MASTER_SITES= ${MASTER_SITE_GNU:=gcc/gcc-${GCC_VERSION}/}
|
||||
EXTRACT_SUFX= .tar.bz2
|
||||
|
||||
MAINTAINER= shannonjr@NetBSD.org
|
||||
HOMEPAGE= http://gcc.gnu.org/
|
||||
COMMENT= This is the gcc 3.4 Ada compiler
|
||||
|
||||
GCC_VERSION= 3.4.6
|
||||
|
||||
PKG_DESTDIR_SUPPORT= none
|
||||
|
||||
USE_TOOLS+= gmake msgfmt
|
||||
HAS_CONFIGURE= YES
|
||||
CONFIGURE_ARGS+= --enable-languages="c,ada"
|
||||
PLIST_SRC= ${WRKDIR}/PLIST_DYNAMIC
|
||||
PATCHDIR= ${.CURDIR}/../../lang/gcc34/patches
|
||||
DISTINFO_FILE= ${.CURDIR}/../../lang/gcc34/distinfo
|
||||
|
||||
.include "../../mk/bsd.prefs.mk"
|
||||
|
||||
# Determine whether to use binutils
|
||||
.if ${OPSYS} == "NetBSD"
|
||||
. if !defined(USE_BINUTILS)
|
||||
AS_PATH:= ${AS}
|
||||
. for _dir_ in ${PATH:C/\:/ /g}
|
||||
. if empty(AS_PATH:M/*)
|
||||
. if exists(${_dir_}/${AS})
|
||||
AS_PATH:= ${_dir_}/${AS}
|
||||
. endif
|
||||
. endif
|
||||
. endfor
|
||||
. if !empty(AS_PATH:M${LOCALBASE}/*)
|
||||
USE_BINUTILS= YES
|
||||
. else
|
||||
AS_VERSION!= ${AS} --version | ${AWK} '{ \
|
||||
split($$3, v, /[.]/); \
|
||||
printf "%02d%02d%02d%02d\n",v[1],v[2],v[3],v[4]; \
|
||||
exit; \
|
||||
}'
|
||||
USE_BINUTILS!= ${TEST} ${AS_VERSION} -lt 02130201 && ${ECHO} YES || ${ECHO} NO
|
||||
. endif
|
||||
MAKEFLAGS+= USE_BINUTILS=${USE_BINUTILS:Q}
|
||||
. endif
|
||||
.endif
|
||||
.if defined(USE_BINUTILS) && !empty(USE_BINUTILS:M[yY][eE][sS])
|
||||
DEPENDS+= binutils>=2.14:../../devel/binutils
|
||||
CONFIGURE_ARGS+= --with-as=${LOCALBASE}/bin/as
|
||||
CONFIGURE_ARGS+= --with-ld=${LOCALBASE}/bin/ld
|
||||
CONFIGURE_ARGS+= --with-gnu-as
|
||||
CONFIGURE_ARGS+= --with-gnu-ld
|
||||
.endif
|
||||
CONFIGURE_ARGS+= --enable-shared
|
||||
MAKE_ENV+= SHELL=${CONFIG_SHELL}
|
||||
|
||||
# Ada bootstrap compiler section
|
||||
# An Ada compiler is required to build the Ada compiler. You
|
||||
# may specify:
|
||||
#USE_GCC34 =# Define to use gcc34
|
||||
# You may also specify the path of a gcc/gnat Ada compiler
|
||||
# outside of the pkgsrc system by specifying the full path
|
||||
# of the compiler (example) below:
|
||||
#ALT_GCC= prefix/bin/gcc
|
||||
.if defined(ALT_GCC)
|
||||
. if exists(${ALT_GCC})
|
||||
ALT_GCC_RTS!= ${ALT_GCC} --print-file-name=adalib
|
||||
. if !empty(ALT_GCC_RTS)
|
||||
RALT_GCC_RTS= ${ALT_GCC_RTS:S%${LOCALBASE}%%:S%/%%}
|
||||
. else
|
||||
PKG_SKIP_REASON+= "${ALT_GCC} does not appear to be an Ada compiler"
|
||||
. endif
|
||||
. else
|
||||
PKG_SKIP_REASON+= "Missing bootstrap Ada compiler"
|
||||
. endif
|
||||
.endif
|
||||
.if !defined(USE_GCC34) && !defined(ALT_GCC)
|
||||
PKG_SKIP_REASON+= "An Ada bootstrap compiler must be specified"
|
||||
.endif
|
||||
|
||||
# Make location overridable, to allow ping-pong bootstraps.
|
||||
GCC34_DEFAULT_SUBPREFIX= gcc34-ada
|
||||
GCC34_INSTALLTO_SUBPREFIX?= ${GCC34_DEFAULT_SUBPREFIX}
|
||||
.if ${GCC34_INSTALLTO_SUBPREFIX} != ${GCC34_DEFAULT_SUBPREFIX}
|
||||
GCC34_PKGMODIF= ${GCC34_INSTALLTO_SUBPREFIX}
|
||||
.endif
|
||||
|
||||
GCC_SUBPREFIX= ${GCC34_INSTALLTO_SUBPREFIX}
|
||||
GCC_PREFIX= ${PREFIX}/${GCC_SUBPREFIX}
|
||||
GCC_PLATFORM= ${LOWER_ARCH}--${LOWER_OPSYS}${APPEND_ELF}${LOWER_OS_VERSION:C/[_a-z].*//}
|
||||
CONFIGURE_ARGS+= --host=${GCC_PLATFORM:Q}
|
||||
GCC_ARCHSUBDIR= ${GCC_SUBPREFIX}/lib/gcc/${GCC_PLATFORM}/${GCC_VERSION}
|
||||
GCC_ARCHDIR= ${PREFIX}/${GCC_ARCHSUBDIR}
|
||||
PLIST_SUBST+= GCC_SUBPREFIX=${GCC_SUBPREFIX:Q}
|
||||
FILES_SUBST+= GCC_PREFIX=${GCC_PREFIX:Q}
|
||||
FILES_SUBST+= PKGNAME=${PKGNAME:Q}
|
||||
MESSAGE_SUBST+= GCC_PREFIX=${GCC_PREFIX}
|
||||
CONFIGURE_ARGS+= --prefix=${GCC_PREFIX:Q}
|
||||
PTHREAD_OPTS+= require native
|
||||
CPPFLAGS+= -I${BUILDLINK_DIR}/include
|
||||
CFLAGS+= -I${BUILDLINK_DIR}/include
|
||||
CONFIGURE_ARGS+= --with-system-zlib
|
||||
CONFIGURE_ARGS+= --enable-long-long
|
||||
CONFIGURE_ARGS+= --enable-threads=gnat
|
||||
GCC_DIR= ${WRKDIR}/.gcc
|
||||
|
||||
post-patch:
|
||||
(cd files; \
|
||||
${CP} adasignal.c ${WRKSRC}/gcc/ada; \
|
||||
${CP} ada_lwp_self.c ${WRKSRC}/gcc/ada; \
|
||||
${CP} dummy_pthreads.c ${WRKSRC}/gcc/ada; \
|
||||
for i in *.adb *.ads ; do \
|
||||
${CP} $$i ${WRKSRC}/gcc/ada; \
|
||||
done )
|
||||
|
||||
.if defined(USE_GCC34)
|
||||
pre-configure:
|
||||
.include "../../lang/gcc34/preconfigure.mk"
|
||||
.elif defined(ALT_GCC)
|
||||
pre-configure:
|
||||
(${TEST} -d ${WRKDIR}/.gcc/bin/ || ${MKDIR} ${WRKDIR}/.gcc/bin/)
|
||||
(cd ${WRKDIR}/.buildlink && ${MKDIR} ${RALT_GCC_RTS} && \
|
||||
cd ${RALT_GCC_RTS} && ${LN} -sf ${ALT_GCC_RTS}/libgnat.a .)
|
||||
(cd ${ALT_GCC:H} && \
|
||||
files=`${FIND} . -type f \( -perm -0100 \) -print` && \
|
||||
cd ${GCC_DIR}/bin/ && \
|
||||
for file in ${ALT_GCC:T} $${files} ; do \
|
||||
${ECHO} '#!${TOOLS_SHELL}' > $${file}; \
|
||||
${ECHO} -n "exec ${ALT_GCC:H}/$${file} " >>$${file}; \
|
||||
${ECHO} '"$$@"' >>$${file}; \
|
||||
${CHMOD} +x $${file}; \
|
||||
done )
|
||||
.endif
|
||||
|
||||
do-configure:
|
||||
${MKDIR} ${WRKDIR}/obj
|
||||
cd ${WRKDIR}/obj && ${SETENV} ${CONFIGURE_ENV} ${WRKSRC}/configure ${CONFIGURE_ARGS}
|
||||
|
||||
do-build:
|
||||
(cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${GMAKE} bootstrap)
|
||||
(cd ${WRKDIR}/obj/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} gnatlib-shared)
|
||||
(cd ${WRKDIR}/obj/gcc && ${SETENV} ${MAKE_ENV} ${GMAKE} gnatlib_and_tools)
|
||||
|
||||
do-test:
|
||||
.if (${MACHINE_GNU_ARCH} == "x86_64")
|
||||
(cd files && ${CP} netbsd64macro.dfs ${WRKSRC}/gcc/testsuite/ada/acats/support/macro.dfs)
|
||||
.endif
|
||||
(cd ${WRKDIR}/obj/gcc && ${GMAKE} check-ada)
|
||||
|
||||
do-install:
|
||||
(cd ${WRKDIR}/obj && ${SETENV} ${MAKE_ENV} ${GMAKE} install \
|
||||
&& ${TEST} -f ${GCC_PREFIX}/bin/cc || ${LN} -f ${GCC_PREFIX}/bin/gcc ${GCC_PREFIX}/bin/cc)
|
||||
(SPECPATH=`${GCC_PREFIX}/bin/gcc -print-file-name=specs` && \
|
||||
for EXPANDEDSPECPATH in $${SPECPATH} ; do \
|
||||
SPECDIR=`${DIRNAME} $${EXPANDEDSPECPATH}`; \
|
||||
${ECHO} $${SPECDIR}/adainclude > $${SPECDIR}/ada_source_path; \
|
||||
${ECHO} $${SPECDIR}/adalib > $${SPECDIR}/ada_object_path; \
|
||||
done )
|
||||
|
||||
post-install:
|
||||
@${SED} ${FILES_SUBST_SED} ${FILESDIR}/ada > ${WRKDIR}/ada
|
||||
${ECHO} '"$$@"' >> ${WRKDIR}/ada
|
||||
${INSTALL_DATA} ${WRKDIR}/ada ${PREFIX}/bin/ada
|
||||
${CHMOD} +x ${WRKDIR}/ada ${PREFIX}/bin/ada
|
||||
${CP} -f ${PKGDIR}/PLIST ${PLIST_SRC}
|
||||
${FIND} ${GCC_PREFIX} \( -type f -o -type l \) -print \
|
||||
| ${SORT} | ${SED} -e "s,${PREFIX}/,,g" \
|
||||
>> ${PLIST_SRC}
|
||||
|
||||
.if defined(USE_GCC34)
|
||||
BUILDLINK_DEPMETHOD.gcc34= build
|
||||
.include "../../lang/gcc34/buildlink3.mk"
|
||||
.endif
|
||||
.include "../../converters/libiconv/buildlink3.mk"
|
||||
.include "../../devel/gettext-lib/buildlink3.mk"
|
||||
.include "../../mk/pthread.buildlink3.mk"
|
||||
.include "../../devel/zlib/buildlink3.mk"
|
||||
.include "../../mk/bsd.pkg.mk"
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
@comment $NetBSD: PLIST,v 1.1.1.1 2004/06/29 18:00:17 shannonjr Exp $
|
||||
bin/ada
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
The Ada compiler front-end of gcc is itself written
|
||||
in Ada. Consequently, an Ada compiler must be used
|
||||
to build this pkg. In pkgsrc, lang/gcc3-ada is version
|
||||
3.3 of the gcc Ada compiler; it also requires an Ada
|
||||
compiler to build. This pkg may also be built using
|
||||
lang/gcc3 (which contains Ada).
|
||||
|
||||
You can download a pre-built Ada compiler, suitable
|
||||
for bootstrapping this package, from:
|
||||
|
||||
http://www.johnrshannon.com/NetBSD/ix86/
|
||||
http://www.johnrshannon.com/NetBSD/x86_64/
|
||||
|
||||
Support is provided for:
|
||||
Intel Ix86 on NetBSD with native pthread support
|
||||
AMD 64 on NetBSD with native pthread support
|
||||
|
||||
See comments in Makefile on selecting a bootstrap compiler.
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
# $NetBSD: buildlink3.mk,v 1.13 2012/05/07 01:53:40 dholland Exp $
|
||||
|
||||
BUILDLINK_PREFIX.gcc34-ada:=${LOCALBASE}/gcc34-ada
|
||||
|
||||
BUILDLINK_TREE+= gcc34-ada
|
||||
|
||||
.if !defined(GCCADA_BUILDLINK3_MK)
|
||||
GCCADA_BUILDLINK3_MK:=
|
||||
|
||||
BUILDLINK_API_DEPENDS.gcc34-ada+= gcc34-ada>=3.4.1nb4
|
||||
BUILDLINK_ABI_DEPENDS.gcc34-ada+= gcc34-ada>=3.4.4nb1
|
||||
BUILDLINK_PKGSRCDIR.gcc34-ada?= ../../lang/gcc34-ada
|
||||
BUILDLINK_ENV+= ADAC=${BUILDLINK_PREFIX.gcc34-ada}/bin/gcc
|
||||
. if exists(${BUILDLINK_PREFIX.gcc34-ada}/bin/gcc)
|
||||
_GCC_ARCHDIR!= ${DIRNAME} `${BUILDLINK_PREFIX.gcc34-ada}/bin/gcc --print-libgcc-file-name`
|
||||
. if empty(_GCC_ARCHDIR:M*not_found*)
|
||||
BUILDLINK_LIBDIRS.gcc34-ada+= lib ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc34-ada}\///}
|
||||
BUILDLINK_LIBDIRS.gcc34-ada+= ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc34-ada}\///}/adalib
|
||||
BUILDLINK_INCDIRS.gcc34-ada+= include ${_GCC_ARCHDIR:S/^${BUILDLINK_PREFIX.gcc34-ada}\///}/adainclude
|
||||
. endif
|
||||
. endif
|
||||
|
||||
BUILDLINK_FILES_CMD.gcc34-ada= (cd ${BUILDLINK_PREFIX.gcc34-ada} && \
|
||||
${FIND} bin libexec lib \( -type file -o -type link \) -print)
|
||||
BUILDLINK_FNAME_TRANSFORM.gcc34-ada= -e s:\buildlink:buildlink/gcc34-ada:
|
||||
|
||||
# Packages that link against shared libraries need a full dependency.
|
||||
. if defined(_USE_GCC_SHLIB)
|
||||
BUILDLINK_DEPMETHOD.gcc34-ada?= full
|
||||
. else
|
||||
BUILDLINK_DEPMETHOD.gcc34-ada?= build
|
||||
. endif
|
||||
|
||||
.include "../../mk/pthread.buildlink3.mk"
|
||||
.include "../../converters/libiconv/buildlink3.mk"
|
||||
.endif # GCCADA_BUILDLINK3_MK
|
||||
|
||||
BUILDLINK_TREE+= -gcc34-ada
|
||||
|
|
@ -1,117 +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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is a NetBSD version of this package.
|
||||
--
|
||||
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 := System.OS_Interface.SIGABRT;
|
||||
-- used by abort,-- 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 := System.OS_Interface.sigpipe;
|
||||
-- write on a pipe with-- 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
|
||||
Sigcld : constant Interrupt_ID := System.OS_Interface.sigchld;
|
||||
-- child status change
|
||||
Sigchld : constant Interrupt_ID := System.OS_Interface.sigchld;
|
||||
-- 4.3BSD's/POSIX name for SIGCLD
|
||||
Sigwinch : constant Interrupt_ID := System.OS_Interface.sigwinch;
|
||||
-- window size change
|
||||
Sigurg : constant Interrupt_ID := System.OS_Interface.sigurg;
|
||||
-- urgent condition on IO channel
|
||||
Sigpoll : constant Interrupt_ID := System.OS_Interface.sigio;
|
||||
-- pollable event occurred
|
||||
Sigio : constant Interrupt_ID := System.OS_Interface.sigio;
|
||||
-- input/output possible,-- SIGPOLL alias (Solaris)
|
||||
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
|
||||
Sigttin : constant Interrupt_ID := System.OS_Interface.sigttin;
|
||||
-- background tty read attempted
|
||||
Sigttou : constant Interrupt_ID := System.OS_Interface.sigttou;
|
||||
-- background tty write attempted
|
||||
Sigvtalrm : constant Interrupt_ID := System.OS_Interface.sigvtalrm;
|
||||
-- virtual timer expired
|
||||
Sigprof : constant Interrupt_ID := System.OS_Interface.sigprof;
|
||||
-- profiling timer expired
|
||||
Sigxcpu : constant Interrupt_ID := System.OS_Interface.sigxcpu;
|
||||
-- CPU time limit exceeded
|
||||
Sigxfsz : constant Interrupt_ID := System.OS_Interface.sigxfsz;
|
||||
-- filesize limit exceeded
|
||||
Sigpwr : constant Interrupt_ID := System.OS_Interface.sigpwr;
|
||||
-- power-fail restart
|
||||
Siginfo : constant Interrupt_ID := System.OS_Interface.siginfo;
|
||||
|
||||
end Ada.Interrupts.Names;
|
||||
|
|
@ -1,646 +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-2001 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 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;
|
||||
|
||||
pragma Linker_Options ("-lposix");
|
||||
pragma Linker_Options ("-lpthread");
|
||||
|
||||
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;
|
||||
|
||||
type int32_t is range -2**31 .. (2**31)-1;
|
||||
for int32_t'Size use 32;
|
||||
|
||||
-----------
|
||||
-- Errno --
|
||||
-----------
|
||||
|
||||
function Errno return int;
|
||||
pragma Import (C, Errno, "__get_errno");
|
||||
|
||||
EPERM : constant := 1; -- Operation not permitted
|
||||
ENOENT : constant := 2; -- No such file or directory
|
||||
ESRCH : constant := 3; -- No such process
|
||||
EINTR : constant := 4; -- Interrupted system call
|
||||
EIO : constant := 5; -- Input/output error
|
||||
ENXIO : constant := 6; -- Device not configured
|
||||
E2BIG : constant := 7; -- Argument list too long
|
||||
ENOEXEC : constant := 8; -- Exec format error
|
||||
EBADF : constant := 9; -- Bad file descriptor
|
||||
ECHILD : constant := 10; -- No child processes
|
||||
EDEADLK : constant := 11; -- Resource deadlock avoided
|
||||
ENOMEM : constant := 12; -- Cannot allocate memory
|
||||
EACCES : constant := 13; -- Permission denied
|
||||
EFAULT : constant := 14; -- Bad address
|
||||
ENOTBLK : constant := 15; -- Block device required
|
||||
EBUSY : constant := 16; -- Device busy
|
||||
EEXIST : constant := 17; -- File exists
|
||||
EXDEV : constant := 18; -- Cross-device link
|
||||
ENODEV : constant := 19;
|
||||
ENOTDIR : constant := 20; -- Not a directory
|
||||
EISDIR : constant := 21; -- Is a directory
|
||||
EINVAL : constant := 22; -- Invalid argument
|
||||
ENFILE : constant := 23;
|
||||
EMFILE : constant := 24; -- Too many open files
|
||||
ENOTTY : constant := 25;
|
||||
ETXTBSY : constant := 26; -- Text file busy
|
||||
EFBIG : constant := 27; -- File too large
|
||||
ENOSPC : constant := 28; -- No space left on device
|
||||
ESPIPE : constant := 29; -- Illegal seek
|
||||
EROFS : constant := 30; -- Read-only file system
|
||||
EMLINK : constant := 31; -- Too many links
|
||||
EPIPE : constant := 32; -- Broken pipe
|
||||
EDOM : constant := 33;
|
||||
ERANGE : constant := 34;
|
||||
EAGAIN : constant := 35;
|
||||
EWOULDBLOCK : constant := EAGAIN; -- Operation would block
|
||||
EINPROGRESS : constant := 36; -- Operation now in progress
|
||||
EALREADY : constant := 37;
|
||||
ENOTSOCK : constant := 38;
|
||||
EDESTADDRREQ : constant := 39;
|
||||
EMSGSIZE : constant := 40; -- Message too long
|
||||
EPROTOTYPE : constant := 41;
|
||||
ENOPROTOOPT : constant := 42; -- Protocol not available
|
||||
EPROTONOSUPPORT : constant := 43; -- Protocol not supported
|
||||
ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported
|
||||
EOPNOTSUPP : constant := 45; -- Operation not supported
|
||||
EPFNOSUPPORT : constant := 46;
|
||||
EAFNOSUPPORT : constant := 47;
|
||||
EADDRINUSE : constant := 48; -- Address already in use
|
||||
EADDRNOTAVAIL : constant := 49;
|
||||
ENETDOWN : constant := 50; -- Network is down
|
||||
ENETUNREACH : constant := 51; -- Network is unreachable
|
||||
ENETRESET : constant := 52;
|
||||
ECONNABORTED : constant := 53;
|
||||
ECONNRESET : constant := 54; -- Connection reset by peer
|
||||
ENOBUFS : constant := 55; -- No buffer space available
|
||||
EISCONN : constant := 56;
|
||||
ENOTCONN : constant := 57; -- Socket is not connected
|
||||
ESHUTDOWN : constant := 58;
|
||||
ETOOMANYREFS : constant := 59;
|
||||
ETIMEDOUT : constant := 60; -- Operation timed out
|
||||
ECONNREFUSED : constant := 61; -- Connection refused
|
||||
ELOOP : constant := 62;
|
||||
ENAMETOOLONG : constant := 63; -- File name too long
|
||||
EHOSTDOWN : constant := 64; -- Host is down
|
||||
EHOSTUNREACH : constant := 65; -- No route to host
|
||||
ENOTEMPTY : constant := 66; -- Directory not empty
|
||||
EPROCLIM : constant := 67; -- Too many processes
|
||||
EUSERS : constant := 68; -- Too many users
|
||||
EDQUOT : constant := 69; -- Disc quota exceeded
|
||||
ESTALE : constant := 70; -- Stale NFS file handle
|
||||
EREMOTE : constant := 71;
|
||||
EBADRPC : constant := 72; -- RPC struct is bad
|
||||
ERPCMISMATCH : constant := 73; -- RPC version wrong
|
||||
EPROGUNAVAIL : constant := 74; -- RPC prog. not avail
|
||||
EPROGMISMATCH : constant := 75; -- Program version wrong
|
||||
EPROCUNAVAIL : constant := 76; -- Bad procedure for program
|
||||
ENOLCK : constant := 77; -- No locks available
|
||||
ENOSYS : constant := 78; -- Function not implemented
|
||||
EFTYPE : constant := 79;
|
||||
EAUTH : constant := 80; -- Authentication error
|
||||
ENEEDAUTH : constant := 81; -- Need authenticator
|
||||
EIDRM : constant := 82; -- Identifier removed
|
||||
ENOMSG : constant := 83; -- No message of desired type
|
||||
EOVERFLOW : constant := 84;
|
||||
EILSEQ : constant := 85; -- Illegal byte sequence
|
||||
ENOTSUP : constant := 86; -- Not supported
|
||||
ECANCELED : constant := 87; -- Operation canceled
|
||||
EBADMSG : constant := 88; -- Bad or Corrupt message
|
||||
ENODATA : constant := 89; -- No message available
|
||||
ENOSR : constant := 90; -- No STREAM resources
|
||||
ENOSTR : constant := 91; -- Not a STREAM
|
||||
ETIME : constant := 92; -- STREAM ioctl timeout
|
||||
ELAST : constant := 92; -- Must equal largest errno
|
||||
|
||||
-------------
|
||||
-- Signals --
|
||||
-------------
|
||||
Max_Interrupt : constant := 64;
|
||||
type Signal is new int range 0 .. Max_Interrupt;
|
||||
for Signal'Size use int'Size;
|
||||
|
||||
sighup : constant := 1; -- hangup
|
||||
sigint : constant := 2; -- interrupt
|
||||
sigquit : constant := 3; -- quit
|
||||
sigill : constant := 4; -- illegal instruction (not reset when caught)
|
||||
sigtrap : constant := 5; -- trace trap (not reset when caught)
|
||||
SIGABRT : constant := 6; -- abort()
|
||||
sigiot : constant := SIGABRT; -- compatibility
|
||||
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; -- sendable stop signal not from tty
|
||||
sigtstp : constant := 18; -- stop signal from tty
|
||||
sigcont : constant := 19; -- continue a stopped process
|
||||
sigchld : constant := 20; -- to parent on child stop or exit
|
||||
sigttin : constant := 21; -- to readers pgrp upon background tty read
|
||||
sigttou : constant := 22; -- like TTIN for output if (tp->t_local<OSTOP)
|
||||
sigio : constant := 23; -- input/output possible signal
|
||||
sigxcpu : constant := 24; -- exceeded CPU time limit
|
||||
sigxfsz : constant := 25; -- exceeded file size limit
|
||||
sigvtalrm : constant := 26; -- virtual time alarm
|
||||
sigprof : constant := 27; -- profiling time alarm
|
||||
sigwinch : constant := 28; -- window size changes
|
||||
siginfo : constant := 29; -- information request
|
||||
sigusr1 : constant := 30; -- user defined signal 1
|
||||
sigusr2 : constant := 31; -- user defined signal 2
|
||||
sigpwr : constant := 32; -- power fail/restart (not reset when caught)
|
||||
sigwaiting : constant := 0; -- process's lwps blocked (Solaris)
|
||||
sigcancel : constant := 0; -- thread cancellation signal (libthread)
|
||||
|
||||
SIGADAABORT : constant := SIGABRT;
|
||||
|
||||
type signal_set is array (Natural range <>) of Signal;
|
||||
|
||||
Unmasked : constant signal_set := (sigkill, sigill, sigprof, sigtrap,
|
||||
sigpwr);
|
||||
|
||||
-- Following signals should not be disturbed.
|
||||
-- See c-posix-signals.c in FLORIST
|
||||
Reserved : constant signal_set := (sigalrm, sigbus, sigill, sigsegv,
|
||||
sigfpe, SIGABRT, sigkill, sigstop);
|
||||
|
||||
-- PTHREAD_SIGMASK(3)
|
||||
SIG_BLOCK : constant := 1;
|
||||
SIG_SETMASK : constant := 3;
|
||||
SIG_UNBLOCK : constant := 2;
|
||||
|
||||
type sigset_t is private;
|
||||
type sigset_t_ptr is access all sigset_t;
|
||||
|
||||
-- Binding to macros defined in <signal.h>
|
||||
function sigaddset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigaddset, "adasigaddset");
|
||||
|
||||
function sigdelset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigdelset, "adasigdelset");
|
||||
|
||||
function sigfillset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigfillset, "adasigfillset");
|
||||
|
||||
function sigismember (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigismember, "adasigismember");
|
||||
|
||||
function sigemptyset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigemptyset, "adasigemptyset");
|
||||
|
||||
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_DFL : constant := 0;
|
||||
SIG_IGN : constant := 1;
|
||||
|
||||
function sigaction
|
||||
(sig : Signal;
|
||||
act : struct_sigaction_ptr;
|
||||
oact : struct_sigaction_ptr := null) return int;
|
||||
pragma Import (C, sigaction, "adasigaction");
|
||||
|
||||
----------
|
||||
-- Time --
|
||||
----------
|
||||
|
||||
type clockid_t is new int;
|
||||
CLOCK_REALTIME : constant := 0;
|
||||
|
||||
type timespec is private;
|
||||
|
||||
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);
|
||||
|
||||
function Gettimeofday (
|
||||
Tv : access Struct_Timeval;
|
||||
Tz : System.Address := System.Null_Address)
|
||||
return int;
|
||||
pragma Import (C, Gettimeofday, "gettimeofday");
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
pragma Import (C, clock_gettime, "clock_gettime");
|
||||
|
||||
|
||||
---------
|
||||
-- LWP --
|
||||
---------
|
||||
|
||||
-- From <sys/types.h>
|
||||
type lwpid_t is new int32_t;
|
||||
|
||||
function lwp_self return System.Address;
|
||||
pragma Import (C, lwp_self, "ada_lwp_self");
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Priority Scheduling --
|
||||
-------------------------
|
||||
|
||||
SCHED_FIFO : constant := 1;
|
||||
SCHED_RR : constant := 2;
|
||||
SCHED_TS : constant := 3;
|
||||
SCHED_OTHER : constant := 3;
|
||||
SCHED_NP : constant := 4;
|
||||
|
||||
function sched_get_priority_min (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_min, "sched_get_priority_min");
|
||||
|
||||
function sched_get_priority_max (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_max, "sched_get_priority_max");
|
||||
|
||||
-------------
|
||||
-- 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");
|
||||
|
||||
-------------
|
||||
-- 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;
|
||||
subtype cond_t is pthread_cond_t;
|
||||
|
||||
PTHREAD_CREATE_DETACHED : constant := 1;
|
||||
|
||||
---------------------------------------
|
||||
-- Nonstandard Thread Initialization --
|
||||
---------------------------------------
|
||||
|
||||
procedure pthread_init;
|
||||
pragma Inline (pthread_init);
|
||||
-- This is a dummy procedure to share some GNULLI files
|
||||
|
||||
-------------------------
|
||||
-- POSIX.1c Section 3 --
|
||||
-------------------------
|
||||
|
||||
function sigwait
|
||||
(set : access sigset_t;
|
||||
sig : access Signal) return int;
|
||||
pragma Import (C, sigwait, "adasigwait");
|
||||
|
||||
function pthread_kill
|
||||
(thread : pthread_t;
|
||||
sig : Signal) return int;
|
||||
pragma Import (C, pthread_kill, "pthread_kill");
|
||||
|
||||
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");
|
||||
|
||||
--------------------------
|
||||
-- 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, "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;
|
||||
end record;
|
||||
for struct_sched_param use record
|
||||
sched_priority at 0 range 0 .. 31;
|
||||
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, "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 : access struct_sched_param)
|
||||
return int;
|
||||
pragma Import (C, pthread_attr_setschedparam, "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");
|
||||
|
||||
---------------------------------------------------------------
|
||||
-- Non portable SGI 6.5 additions to the pthread interface --
|
||||
-- must be executed from within the context of a system --
|
||||
-- scope task --
|
||||
---------------------------------------------------------------
|
||||
|
||||
function pthread_setrunon_np (cpu : int) return int;
|
||||
pragma Import (C, pthread_setrunon_np, "pthread_setrunon_np");
|
||||
|
||||
private
|
||||
|
||||
type array_type_1 is array (Integer range 0 .. 3) of unsigned;
|
||||
type sigset_t is record
|
||||
X_X_sigbits : array_type_1;
|
||||
end record;
|
||||
pragma Convention (C, sigset_t);
|
||||
|
||||
-- From <sys/ansi.h>
|
||||
type pid_t is new int32_t;
|
||||
|
||||
type time_t is new int32_t;
|
||||
|
||||
type timespec is record
|
||||
tv_sec : time_t;
|
||||
tv_nsec : long;
|
||||
end record;
|
||||
for timespec use record
|
||||
tv_sec at 0 range 0 .. 63;
|
||||
tv_nsec at 8 range 0 .. 63;
|
||||
end record;
|
||||
pragma Warnings (Off);
|
||||
-- There may be holes in the record, due to
|
||||
-- components not defined by POSIX standard.
|
||||
for timespec'Size use 128;
|
||||
pragma Convention (C, timespec);
|
||||
|
||||
type suseconds_t is range -2**63 .. (2**63)-1;
|
||||
for suseconds_t'Size use 64;
|
||||
type struct_timeval is record
|
||||
tv_sec : time_t;
|
||||
tv_usec : suseconds_t;
|
||||
end record;
|
||||
for struct_timeval use record
|
||||
tv_sec at 0 range 0 .. 63;
|
||||
tv_usec at 8 range 0 .. 63;
|
||||
end record;
|
||||
pragma Convention (C, struct_timeval);
|
||||
pragma Warnings (Off);
|
||||
-- There may be holes in the record, due to
|
||||
-- components not defined by POSIX standard.
|
||||
for struct_timeval'Size use 128;
|
||||
pragma Warnings (On);
|
||||
|
||||
|
||||
type array_type_9 is array (Integer range 0 .. 4) of long;
|
||||
type pthread_attr_t is record
|
||||
X_X_D : array_type_9;
|
||||
end record;
|
||||
pragma Convention (C, pthread_attr_t);
|
||||
|
||||
type array_type_8 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_condattr_t is record
|
||||
X_X_D : array_type_8;
|
||||
end record;
|
||||
pragma Convention (C, pthread_condattr_t);
|
||||
|
||||
type array_type_7 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_mutexattr_t is record
|
||||
X_X_D : array_type_7;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutexattr_t);
|
||||
|
||||
type pthread_t is new System.Address;
|
||||
|
||||
type array_type_10 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_mutex_t is record
|
||||
X_X_D : array_type_10;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutex_t);
|
||||
|
||||
type array_type_11 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_cond_t is record
|
||||
X_X_D : array_type_11;
|
||||
end record;
|
||||
pragma Convention (C, pthread_cond_t);
|
||||
|
||||
type pthread_key_t is new int;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- (GNU-Linux/x86 Version) --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 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.000_001;
|
||||
|
||||
-- Storage-related Declarations
|
||||
|
||||
type Address is private;
|
||||
Null_Address : constant Address;
|
||||
|
||||
Storage_Unit : constant := 8;
|
||||
Word_Size : constant := 64;
|
||||
Memory_Size : constant := 2 ** 64;
|
||||
|
||||
-- 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 := Low_Order_First;
|
||||
|
||||
-- Priority-related Declarations (RM D.1)
|
||||
|
||||
Max_Priority : constant Positive := 30;
|
||||
Max_Interrupt_Priority : constant Positive := 31;
|
||||
|
||||
subtype Any_Priority is Integer range 0 .. 31;
|
||||
subtype Priority is Any_Priority range 0 .. 30;
|
||||
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
|
||||
|
||||
Default_Priority : constant Priority := 15;
|
||||
|
||||
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;
|
||||
|
|
@ -1,274 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is the NetBSD threads version of this package
|
||||
|
||||
-- PLEASE DO NOT add any dependences on other packages. ??? why not ???
|
||||
-- This package is designed to work with or without tasking support.
|
||||
|
||||
-- See the other warnings in the package specification before making
|
||||
-- any modifications to this file.
|
||||
|
||||
-- Make a careful study of all signals available under the OS, to see which
|
||||
-- need to be reserved, kept always unmasked, or kept always unmasked. Be on
|
||||
-- the lookout for special signals that may be used by the thread library.
|
||||
|
||||
-- Since this is a multi target file, the signal <-> exception mapping
|
||||
-- is simple minded. If you need a more precise and target specific
|
||||
-- signal handling, create a new s-intman.adb that will fit your needs.
|
||||
|
||||
-- This file assumes that:
|
||||
|
||||
-- sigfpe, sigill, sigsegv and sigbus exist. They are mapped as follows:
|
||||
-- sigfpe => Constraint_Error
|
||||
-- sigill => Program_Error
|
||||
-- sigill => Storage_Error
|
||||
-- sigbus => Storage_Error
|
||||
|
||||
-- sigint exists and will be kept unmasked unless the pragma
|
||||
-- Unreserve_All_Interrupts is specified anywhere in the application.
|
||||
|
||||
-- System.OS_Interface contains the following:
|
||||
-- SIGADAABORT: the signal that will be used to abort tasks.
|
||||
-- Unmasked: the OS specific set of signals that should be unmasked in
|
||||
-- all the threads. SIGADAABORT is unmasked by
|
||||
-- default
|
||||
-- Reserved: the OS specific set of signals that are reserved.
|
||||
|
||||
with Interfaces.C;
|
||||
-- used for int and other types
|
||||
|
||||
with System.OS_Interface;
|
||||
-- used for various Constants, Signal and types
|
||||
|
||||
package body System.Interrupt_Management is
|
||||
|
||||
use Interfaces.C;
|
||||
use System.OS_Interface;
|
||||
|
||||
type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
|
||||
Exception_Interrupts : constant Interrupt_List :=
|
||||
(sigfpe, sigill, sigsegv, sigbus);
|
||||
|
||||
Unreserve_All_Interrupts : Interfaces.C.int;
|
||||
pragma Import
|
||||
(C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
|
||||
|
||||
-----------------------
|
||||
-- Local Subprograms --
|
||||
-----------------------
|
||||
|
||||
procedure Notify_Exception (signo : Signal);
|
||||
-- This function identifies the Ada exception to be raised using
|
||||
-- the information when the system received a synchronous signal.
|
||||
-- Since this function is machine and OS dependent, different code
|
||||
-- has to be provided for different target.
|
||||
|
||||
----------------------
|
||||
-- Notify_Exception --
|
||||
----------------------
|
||||
|
||||
Signal_Mask : aliased sigset_t;
|
||||
-- The set of signals handled by Notify_Exception
|
||||
|
||||
procedure Notify_Exception (signo : Signal) is
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
begin
|
||||
-- With the __builtin_longjmp, the signal mask is not restored, so we
|
||||
-- need to restore it explicitely.
|
||||
|
||||
Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
|
||||
pragma Assert (Result = 0);
|
||||
|
||||
-- Check that treatment of exception propagation here
|
||||
-- is consistent with treatment of the abort signal in
|
||||
-- System.Task_Primitives.Operations.
|
||||
|
||||
case signo is
|
||||
when sigfpe =>
|
||||
raise Constraint_Error;
|
||||
when sigill =>
|
||||
raise Program_Error;
|
||||
when sigbus | sigsegv =>
|
||||
raise Storage_Error;
|
||||
when others =>
|
||||
null;
|
||||
end case;
|
||||
end Notify_Exception;
|
||||
|
||||
---------------------------
|
||||
-- Initialize_Interrupts --
|
||||
---------------------------
|
||||
|
||||
-- Nothing needs to be done on this platform.
|
||||
|
||||
procedure Initialize_Interrupts is
|
||||
begin
|
||||
null;
|
||||
end Initialize_Interrupts;
|
||||
|
||||
-------------------------
|
||||
-- Package Elaboration --
|
||||
-------------------------
|
||||
|
||||
begin
|
||||
declare
|
||||
act : aliased struct_sigaction;
|
||||
old_act : aliased struct_sigaction;
|
||||
Result : System.OS_Interface.int;
|
||||
|
||||
function State (Int : Interrupt_ID) return Character;
|
||||
pragma Import (C, State, "__gnat_get_interrupt_state");
|
||||
-- Get interrupt state. Defined in a-init.c
|
||||
-- The input argument is the interrupt number,
|
||||
-- and the result is one of the following:
|
||||
|
||||
User : constant Character := 'u';
|
||||
Runtime : constant Character := 'r';
|
||||
Default : constant Character := 's';
|
||||
-- 'n' this interrupt not set by any Interrupt_State pragma
|
||||
-- 'u' Interrupt_State pragma set state to User
|
||||
-- 'r' Interrupt_State pragma set state to Runtime
|
||||
-- 's' Interrupt_State pragma set state to System (use "default"
|
||||
-- system handler)
|
||||
|
||||
begin
|
||||
-- Need to call pthread_init very early because it is doing signal
|
||||
-- initializations.
|
||||
|
||||
pthread_init;
|
||||
|
||||
Abort_Task_Interrupt := SIGADAABORT;
|
||||
|
||||
act.sa_handler := Notify_Exception'Address;
|
||||
|
||||
act.sa_flags := 0;
|
||||
|
||||
-- On some targets, we set sa_flags to SA_NODEFER so that during the
|
||||
-- handler execution we do not change the Signal_Mask to be masked for
|
||||
-- the Signal.
|
||||
|
||||
-- This is a temporary fix to the problem that the Signal_Mask is
|
||||
-- not restored after the exception (longjmp) from the handler.
|
||||
-- The right fix should be made in sigsetjmp so that we save
|
||||
-- the Signal_Set and restore it after a longjmp.
|
||||
|
||||
-- Since SA_NODEFER is obsolete, instead we reset explicitely
|
||||
-- the mask in the exception handler.
|
||||
|
||||
Result := sigemptyset (Signal_Mask'Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
||||
-- Add signals that map to Ada exceptions to the mask.
|
||||
for J in Exception_Interrupts'Range loop
|
||||
if State (Exception_Interrupts (J)) /= Default then
|
||||
Result :=
|
||||
sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J)));
|
||||
pragma Assert (Result = 0);
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
act.sa_mask := Signal_Mask;
|
||||
|
||||
pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
|
||||
pragma Assert (Reserve = (Interrupt_ID'Range => False));
|
||||
|
||||
-- Process state of exception signals
|
||||
for J in Exception_Interrupts'Range loop
|
||||
if State (Exception_Interrupts (J)) /= User then
|
||||
Keep_Unmasked (Exception_Interrupts (J)) := True;
|
||||
Reserve (Exception_Interrupts (J)) := True;
|
||||
|
||||
if State (Exception_Interrupts (J)) /= Default then
|
||||
Result :=
|
||||
sigaction
|
||||
(Signal (Exception_Interrupts (J)), act'Unchecked_Access,
|
||||
old_act'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if State (Abort_Task_Interrupt) /= User then
|
||||
Keep_Unmasked (Abort_Task_Interrupt) := True;
|
||||
Reserve (Abort_Task_Interrupt) := True;
|
||||
end if;
|
||||
|
||||
-- Set sigint to unmasked state as long as it is not in "User"
|
||||
-- state. Check for Unreserve_All_Interrupts last
|
||||
|
||||
if State (sigint) /= User then
|
||||
Keep_Unmasked (sigint) := True;
|
||||
Reserve (sigint) := True;
|
||||
end if;
|
||||
|
||||
-- Check all signals for state that requires keeping them
|
||||
-- unmasked and reserved
|
||||
|
||||
for J in Interrupt_ID'Range loop
|
||||
if State (J) = Default or else State (J) = Runtime then
|
||||
Keep_Unmasked (J) := True;
|
||||
Reserve (J) := True;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Add the set of signals that must always be unmasked for this target
|
||||
|
||||
for J in Unmasked'Range loop
|
||||
Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
|
||||
Reserve (Interrupt_ID (Unmasked (J))) := True;
|
||||
end loop;
|
||||
|
||||
-- Add target-specific reserved signals
|
||||
|
||||
for J in Reserved'Range loop
|
||||
Reserve (Interrupt_ID (Reserved (J))) := True;
|
||||
end loop;
|
||||
|
||||
-- Process pragma Unreserve_All_Interrupts. This overrides any
|
||||
-- settings due to pragma Interrupt_State:
|
||||
|
||||
if Unreserve_All_Interrupts /= 0 then
|
||||
Keep_Unmasked (sigint) := False;
|
||||
Reserve (sigint) := False;
|
||||
end if;
|
||||
|
||||
-- We do not have Signal 0 in reality. We just use this value
|
||||
-- to identify non-existent signals (see s-intnam.ads). Therefore,
|
||||
-- Signal 0 should not be used in all signal related operations hence
|
||||
-- mark it as reserved.
|
||||
|
||||
Reserve (0) := True;
|
||||
end;
|
||||
end System.Interrupt_Management;
|
||||
|
|
@ -1,115 +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-2001 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 the NetBSD 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
|
||||
|
||||
------------------
|
||||
-- pthread_init --
|
||||
------------------
|
||||
|
||||
procedure pthread_init is
|
||||
begin
|
||||
null;
|
||||
end pthread_init;
|
||||
|
||||
-----------------
|
||||
-- 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;
|
||||
|
||||
function To_Timeval (D : Duration) return struct_timeval 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 struct_timeval'(tv_sec => S,
|
||||
tv_usec => suseconds_t (Long_Long_Integer (F * 10#1#E6)));
|
||||
end To_Timeval;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
|
@ -1,634 +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-2001 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 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;
|
||||
|
||||
pragma Linker_Options ("-lposix");
|
||||
pragma Linker_Options ("-lpthread");
|
||||
|
||||
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;
|
||||
|
||||
type int32_t is range -2**31 .. (2**31)-1;
|
||||
for int32_t'Size use 32;
|
||||
|
||||
-----------
|
||||
-- Errno --
|
||||
-----------
|
||||
|
||||
function Errno return int;
|
||||
pragma Import (C, Errno, "__get_errno");
|
||||
|
||||
EPERM : constant := 1; -- Operation not permitted
|
||||
ENOENT : constant := 2; -- No such file or directory
|
||||
ESRCH : constant := 3; -- No such process
|
||||
EINTR : constant := 4; -- Interrupted system call
|
||||
EIO : constant := 5; -- Input/output error
|
||||
ENXIO : constant := 6; -- Device not configured
|
||||
E2BIG : constant := 7; -- Argument list too long
|
||||
ENOEXEC : constant := 8; -- Exec format error
|
||||
EBADF : constant := 9; -- Bad file descriptor
|
||||
ECHILD : constant := 10; -- No child processes
|
||||
EDEADLK : constant := 11; -- Resource deadlock avoided
|
||||
ENOMEM : constant := 12; -- Cannot allocate memory
|
||||
EACCES : constant := 13; -- Permission denied
|
||||
EFAULT : constant := 14; -- Bad address
|
||||
ENOTBLK : constant := 15; -- Block device required
|
||||
EBUSY : constant := 16; -- Device busy
|
||||
EEXIST : constant := 17; -- File exists
|
||||
EXDEV : constant := 18; -- Cross-device link
|
||||
ENODEV : constant := 19;
|
||||
ENOTDIR : constant := 20; -- Not a directory
|
||||
EISDIR : constant := 21; -- Is a directory
|
||||
EINVAL : constant := 22; -- Invalid argument
|
||||
ENFILE : constant := 23;
|
||||
EMFILE : constant := 24; -- Too many open files
|
||||
ENOTTY : constant := 25;
|
||||
ETXTBSY : constant := 26; -- Text file busy
|
||||
EFBIG : constant := 27; -- File too large
|
||||
ENOSPC : constant := 28; -- No space left on device
|
||||
ESPIPE : constant := 29; -- Illegal seek
|
||||
EROFS : constant := 30; -- Read-only file system
|
||||
EMLINK : constant := 31; -- Too many links
|
||||
EPIPE : constant := 32; -- Broken pipe
|
||||
EDOM : constant := 33;
|
||||
ERANGE : constant := 34;
|
||||
EAGAIN : constant := 35;
|
||||
EWOULDBLOCK : constant := EAGAIN; -- Operation would block
|
||||
EINPROGRESS : constant := 36; -- Operation now in progress
|
||||
EALREADY : constant := 37;
|
||||
ENOTSOCK : constant := 38;
|
||||
EDESTADDRREQ : constant := 39;
|
||||
EMSGSIZE : constant := 40; -- Message too long
|
||||
EPROTOTYPE : constant := 41;
|
||||
ENOPROTOOPT : constant := 42; -- Protocol not available
|
||||
EPROTONOSUPPORT : constant := 43; -- Protocol not supported
|
||||
ESOCKTNOSUPPORT : constant := 44; -- Socket type not supported
|
||||
EOPNOTSUPP : constant := 45; -- Operation not supported
|
||||
EPFNOSUPPORT : constant := 46;
|
||||
EAFNOSUPPORT : constant := 47;
|
||||
EADDRINUSE : constant := 48; -- Address already in use
|
||||
EADDRNOTAVAIL : constant := 49;
|
||||
ENETDOWN : constant := 50; -- Network is down
|
||||
ENETUNREACH : constant := 51; -- Network is unreachable
|
||||
ENETRESET : constant := 52;
|
||||
ECONNABORTED : constant := 53;
|
||||
ECONNRESET : constant := 54; -- Connection reset by peer
|
||||
ENOBUFS : constant := 55; -- No buffer space available
|
||||
EISCONN : constant := 56;
|
||||
ENOTCONN : constant := 57; -- Socket is not connected
|
||||
ESHUTDOWN : constant := 58;
|
||||
ETOOMANYREFS : constant := 59;
|
||||
ETIMEDOUT : constant := 60; -- Operation timed out
|
||||
ECONNREFUSED : constant := 61; -- Connection refused
|
||||
ELOOP : constant := 62;
|
||||
ENAMETOOLONG : constant := 63; -- File name too long
|
||||
EHOSTDOWN : constant := 64; -- Host is down
|
||||
EHOSTUNREACH : constant := 65; -- No route to host
|
||||
ENOTEMPTY : constant := 66; -- Directory not empty
|
||||
EPROCLIM : constant := 67; -- Too many processes
|
||||
EUSERS : constant := 68; -- Too many users
|
||||
EDQUOT : constant := 69; -- Disc quota exceeded
|
||||
ESTALE : constant := 70; -- Stale NFS file handle
|
||||
EREMOTE : constant := 71;
|
||||
EBADRPC : constant := 72; -- RPC struct is bad
|
||||
ERPCMISMATCH : constant := 73; -- RPC version wrong
|
||||
EPROGUNAVAIL : constant := 74; -- RPC prog. not avail
|
||||
EPROGMISMATCH : constant := 75; -- Program version wrong
|
||||
EPROCUNAVAIL : constant := 76; -- Bad procedure for program
|
||||
ENOLCK : constant := 77; -- No locks available
|
||||
ENOSYS : constant := 78; -- Function not implemented
|
||||
EFTYPE : constant := 79;
|
||||
EAUTH : constant := 80; -- Authentication error
|
||||
ENEEDAUTH : constant := 81; -- Need authenticator
|
||||
EIDRM : constant := 82; -- Identifier removed
|
||||
ENOMSG : constant := 83; -- No message of desired type
|
||||
EOVERFLOW : constant := 84;
|
||||
EILSEQ : constant := 85; -- Illegal byte sequence
|
||||
ENOTSUP : constant := 86; -- Not supported
|
||||
ECANCELED : constant := 87; -- Operation canceled
|
||||
EBADMSG : constant := 88; -- Bad or Corrupt message
|
||||
ENODATA : constant := 89; -- No message available
|
||||
ENOSR : constant := 90; -- No STREAM resources
|
||||
ENOSTR : constant := 91; -- Not a STREAM
|
||||
ETIME : constant := 92; -- STREAM ioctl timeout
|
||||
ELAST : constant := 92; -- Must equal largest errno
|
||||
|
||||
-------------
|
||||
-- Signals --
|
||||
-------------
|
||||
Max_Interrupt : constant := 64;
|
||||
type Signal is new int range 0 .. Max_Interrupt;
|
||||
for Signal'Size use int'Size;
|
||||
|
||||
sighup : constant := 1; -- hangup
|
||||
sigint : constant := 2; -- interrupt
|
||||
sigquit : constant := 3; -- quit
|
||||
sigill : constant := 4; -- illegal instruction (not reset when caught)
|
||||
sigtrap : constant := 5; -- trace trap (not reset when caught)
|
||||
SIGABRT : constant := 6; -- abort()
|
||||
sigiot : constant := SIGABRT; -- compatibility
|
||||
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; -- sendable stop signal not from tty
|
||||
sigtstp : constant := 18; -- stop signal from tty
|
||||
sigcont : constant := 19; -- continue a stopped process
|
||||
sigchld : constant := 20; -- to parent on child stop or exit
|
||||
sigttin : constant := 21; -- to readers pgrp upon background tty read
|
||||
sigttou : constant := 22; -- like TTIN for output if (tp->t_local<OSTOP)
|
||||
sigio : constant := 23; -- input/output possible signal
|
||||
sigxcpu : constant := 24; -- exceeded CPU time limit
|
||||
sigxfsz : constant := 25; -- exceeded file size limit
|
||||
sigvtalrm : constant := 26; -- virtual time alarm
|
||||
sigprof : constant := 27; -- profiling time alarm
|
||||
sigwinch : constant := 28; -- window size changes
|
||||
siginfo : constant := 29; -- information request
|
||||
sigusr1 : constant := 30; -- user defined signal 1
|
||||
sigusr2 : constant := 31; -- user defined signal 2
|
||||
sigpwr : constant := 32; -- power fail/restart (not reset when caught)
|
||||
sigwaiting : constant := 0; -- process's lwps blocked (Solaris)
|
||||
sigcancel : constant := 0; -- thread cancellation signal (libthread)
|
||||
|
||||
SIGADAABORT : constant := SIGABRT;
|
||||
|
||||
type signal_set is array (Natural range <>) of Signal;
|
||||
|
||||
Unmasked : constant signal_set := (sigkill, sigill, sigprof, sigtrap,
|
||||
sigpwr);
|
||||
|
||||
-- Following signals should not be disturbed.
|
||||
-- See c-posix-signals.c in FLORIST
|
||||
Reserved : constant signal_set := (sigalrm, sigbus, sigill, sigsegv,
|
||||
sigfpe, SIGABRT, sigkill, sigstop);
|
||||
|
||||
-- PTHREAD_SIGMASK(3)
|
||||
SIG_BLOCK : constant := 1;
|
||||
SIG_SETMASK : constant := 3;
|
||||
SIG_UNBLOCK : constant := 2;
|
||||
|
||||
type sigset_t is private;
|
||||
type sigset_t_ptr is access all sigset_t;
|
||||
|
||||
-- Binding to macros defined in <signal.h>
|
||||
function sigaddset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigaddset, "adasigaddset");
|
||||
|
||||
function sigdelset (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigdelset, "adasigdelset");
|
||||
|
||||
function sigfillset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigfillset, "adasigfillset");
|
||||
|
||||
function sigismember (set : access sigset_t; sig : Signal) return int;
|
||||
pragma Import (C, sigismember, "adasigismember");
|
||||
|
||||
function sigemptyset (set : access sigset_t) return int;
|
||||
pragma Import (C, sigemptyset, "adasigemptyset");
|
||||
|
||||
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_DFL : constant := 0;
|
||||
SIG_IGN : constant := 1;
|
||||
|
||||
function sigaction
|
||||
(sig : Signal;
|
||||
act : struct_sigaction_ptr;
|
||||
oact : struct_sigaction_ptr := null) return int;
|
||||
pragma Import (C, sigaction, "adasigaction");
|
||||
|
||||
----------
|
||||
-- Time --
|
||||
----------
|
||||
|
||||
type clockid_t is new int;
|
||||
CLOCK_REALTIME : constant := 0;
|
||||
|
||||
type timespec is private;
|
||||
|
||||
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);
|
||||
|
||||
function Gettimeofday (
|
||||
Tv : access Struct_Timeval;
|
||||
Tz : System.Address := System.Null_Address)
|
||||
return int;
|
||||
pragma Import (C, Gettimeofday, "gettimeofday");
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : clockid_t;
|
||||
tp : access timespec) return int;
|
||||
pragma Import (C, clock_gettime, "clock_gettime");
|
||||
|
||||
|
||||
---------
|
||||
-- LWP --
|
||||
---------
|
||||
|
||||
type lwpid_t is new int32_t;
|
||||
|
||||
function lwp_self return System.Address;
|
||||
pragma Import (C, lwp_self, "ada_lwp_self");
|
||||
|
||||
|
||||
-------------------------
|
||||
-- Priority Scheduling --
|
||||
-------------------------
|
||||
|
||||
SCHED_FIFO : constant := 1;
|
||||
SCHED_RR : constant := 2;
|
||||
SCHED_TS : constant := 3;
|
||||
SCHED_OTHER : constant := 3;
|
||||
SCHED_NP : constant := 4;
|
||||
|
||||
function sched_get_priority_min (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_min, "sched_get_priority_min");
|
||||
|
||||
function sched_get_priority_max (Policy : int) return int;
|
||||
pragma Import (C, sched_get_priority_max, "sched_get_priority_max");
|
||||
|
||||
-------------
|
||||
-- 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");
|
||||
|
||||
-------------
|
||||
-- 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;
|
||||
subtype cond_t is pthread_cond_t;
|
||||
|
||||
PTHREAD_CREATE_DETACHED : constant := 1;
|
||||
|
||||
---------------------------------------
|
||||
-- Nonstandard Thread Initialization --
|
||||
---------------------------------------
|
||||
|
||||
procedure pthread_init;
|
||||
pragma Inline (pthread_init);
|
||||
-- This is a dummy procedure to share some GNULLI files
|
||||
|
||||
-------------------------
|
||||
-- POSIX.1c Section 3 --
|
||||
-------------------------
|
||||
|
||||
function sigwait
|
||||
(set : access sigset_t;
|
||||
sig : access Signal) return int;
|
||||
pragma Import (C, sigwait, "adasigwait");
|
||||
|
||||
function pthread_kill
|
||||
(thread : pthread_t;
|
||||
sig : Signal) return int;
|
||||
pragma Import (C, pthread_kill, "pthread_kill");
|
||||
|
||||
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");
|
||||
|
||||
--------------------------
|
||||
-- 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, "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;
|
||||
end record;
|
||||
for struct_sched_param use record
|
||||
sched_priority at 0 range 0 .. 31;
|
||||
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, "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 : access struct_sched_param)
|
||||
return int;
|
||||
pragma Import (C, pthread_attr_setschedparam, "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");
|
||||
|
||||
---------------------------------------------------------------
|
||||
-- Non portable SGI 6.5 additions to the pthread interface --
|
||||
-- must be executed from within the context of a system --
|
||||
-- scope task --
|
||||
---------------------------------------------------------------
|
||||
|
||||
function pthread_setrunon_np (cpu : int) return int;
|
||||
pragma Import (C, pthread_setrunon_np, "pthread_setrunon_np");
|
||||
|
||||
private
|
||||
|
||||
type array_type_1 is array (Integer range 0 .. 3) of unsigned;
|
||||
type sigset_t is record
|
||||
X_X_sigbits : array_type_1;
|
||||
end record;
|
||||
pragma Convention (C, sigset_t);
|
||||
|
||||
type pid_t is new int32_t;
|
||||
|
||||
type time_t is new int32_t;
|
||||
|
||||
type suseconds_t is new int32_t;
|
||||
|
||||
type timespec is record
|
||||
tv_sec : time_t;
|
||||
tv_nsec : long;
|
||||
end record;
|
||||
for timespec use record
|
||||
tv_sec at 0 range 0 .. 31;
|
||||
tv_nsec at 4 range 0 .. 31;
|
||||
end record;
|
||||
pragma Convention (C, timespec);
|
||||
|
||||
type struct_timeval is record
|
||||
tv_sec : time_t;
|
||||
tv_usec : suseconds_t;
|
||||
end record;
|
||||
for struct_timeval use record
|
||||
tv_sec at 0 range 0 .. 31;
|
||||
tv_usec at 4 range 0 .. 31;
|
||||
end record;
|
||||
pragma Convention (C, struct_timeval);
|
||||
|
||||
type array_type_9 is array (Integer range 0 .. 4) of long;
|
||||
type pthread_attr_t is record
|
||||
X_X_D : array_type_9;
|
||||
end record;
|
||||
pragma Convention (C, pthread_attr_t);
|
||||
|
||||
type array_type_8 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_condattr_t is record
|
||||
X_X_D : array_type_8;
|
||||
end record;
|
||||
pragma Convention (C, pthread_condattr_t);
|
||||
|
||||
type array_type_7 is array (Integer range 0 .. 1) of long;
|
||||
type pthread_mutexattr_t is record
|
||||
X_X_D : array_type_7;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutexattr_t);
|
||||
|
||||
type pthread_t is new unsigned;
|
||||
|
||||
type array_type_10 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_mutex_t is record
|
||||
X_X_D : array_type_10;
|
||||
end record;
|
||||
pragma Convention (C, pthread_mutex_t);
|
||||
|
||||
type array_type_11 is array (Integer range 0 .. 7) of long;
|
||||
type pthread_cond_t is record
|
||||
X_X_D : array_type_11;
|
||||
end record;
|
||||
pragma Convention (C, pthread_cond_t);
|
||||
|
||||
type pthread_key_t is new int;
|
||||
|
||||
end System.OS_Interface;
|
||||
|
|
@ -1,79 +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) 1998-2001 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 Solaris (native) specific version
|
||||
|
||||
package body System.Parameters is
|
||||
|
||||
------------------------
|
||||
-- Default_Stack_Size --
|
||||
------------------------
|
||||
|
||||
function Default_Stack_Size return Size_Type is
|
||||
begin
|
||||
return 8318976;
|
||||
end Default_Stack_Size;
|
||||
|
||||
------------------------
|
||||
-- Minimum_Stack_Size --
|
||||
------------------------
|
||||
|
||||
function Minimum_Stack_Size return Size_Type is
|
||||
|
||||
thr_min_stack : constant Size_Type := 1160;
|
||||
-- This value does not really matter anyway, since this is checked
|
||||
-- and adjusted at the library level when creating a thread.
|
||||
|
||||
begin
|
||||
return thr_min_stack;
|
||||
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;
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- (GNU-Linux/x86 Version) --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 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.000_001;
|
||||
|
||||
-- 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 := Low_Order_First;
|
||||
|
||||
-- Priority-related Declarations (RM D.1)
|
||||
|
||||
Max_Priority : constant Positive := 30;
|
||||
Max_Interrupt_Priority : constant Positive := 31;
|
||||
|
||||
subtype Any_Priority is Integer range 0 .. 31;
|
||||
subtype Priority is Any_Priority range 0 .. 30;
|
||||
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
|
||||
|
||||
Default_Priority : constant Priority := 15;
|
||||
|
||||
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;
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,143 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . T A S K _ I N F O --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2000 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 package contains the definitions and routines associated with the
|
||||
-- implementation of the Task_Info pragma.
|
||||
|
||||
-- This is the NetBSD (native) version of this module.
|
||||
|
||||
with System.OS_Interface;
|
||||
with Unchecked_Deallocation;
|
||||
package System.Task_Info is
|
||||
pragma Elaborate_Body;
|
||||
-- To ensure that a body is allowed
|
||||
|
||||
-----------------------------------------------------
|
||||
-- Binding of Tasks to LWPs and LWPs to processors --
|
||||
-----------------------------------------------------
|
||||
|
||||
-- The NetBSD implementation of the GNU Low-Level Interface (GNULLI)
|
||||
-- implements each Ada task as a NetBSD thread. The NetBSD thread
|
||||
-- library distributes threads across one or more LWPs (Light Weight
|
||||
-- Process) that are members of the same process. NetBSD distributes
|
||||
-- processes and LWPs across the available CPUs on a given machine. The
|
||||
-- pragma Task_Info provides the mechanism to control the distribution
|
||||
-- of tasks to LWPs, and LWPs to processors.
|
||||
|
||||
-- Each thread has a number of attributes that dictate it's scheduling.
|
||||
-- These attributes are:
|
||||
--
|
||||
-- New_LWP: whether a new LWP is created for this thread.
|
||||
--
|
||||
-- Bound_To_LWP: whether the thread is bound to a specific LWP
|
||||
-- for its entire lifetime.
|
||||
--
|
||||
-- CPU: the CPU number associated to the LWP
|
||||
--
|
||||
|
||||
-- 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 Task_Info_Unspecified 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_Number is System.OS_Interface.processorid_t;
|
||||
|
||||
CPU_UNCHANGED : constant CPU_Number := System.OS_Interface.PBIND_QUERY;
|
||||
-- Do not bind the LWP to a specific processor
|
||||
|
||||
ANY_CPU : constant CPU_Number := System.OS_Interface.PBIND_NONE;
|
||||
-- Bind the LWP to any processor
|
||||
|
||||
Invalid_CPU_Number : exception;
|
||||
|
||||
type Thread_Attributes (New_LWP : Boolean) is record
|
||||
Bound_To_LWP : Boolean := True;
|
||||
case New_LWP is
|
||||
when False =>
|
||||
null;
|
||||
when True =>
|
||||
CPU : CPU_Number := CPU_UNCHANGED;
|
||||
end case;
|
||||
end record;
|
||||
|
||||
Default_Thread_Attributes : constant Thread_Attributes := (False, True);
|
||||
|
||||
function Unbound_Thread_Attributes
|
||||
return Thread_Attributes;
|
||||
|
||||
function Bound_Thread_Attributes
|
||||
return Thread_Attributes;
|
||||
|
||||
function Bound_Thread_Attributes (CPU : CPU_Number)
|
||||
return Thread_Attributes;
|
||||
|
||||
type Task_Info_Type is access all Thread_Attributes;
|
||||
|
||||
function New_Unbound_Thread_Attributes
|
||||
return Task_Info_Type;
|
||||
|
||||
function New_Bound_Thread_Attributes
|
||||
return Task_Info_Type;
|
||||
|
||||
function New_Bound_Thread_Attributes (CPU : CPU_Number)
|
||||
return Task_Info_Type;
|
||||
|
||||
type Task_Image_Type is access String;
|
||||
-- Used to generate a meaningful identifier for tasks that are variables
|
||||
-- and components of variables.
|
||||
|
||||
procedure Free_Task_Image is new
|
||||
Unchecked_Deallocation (String, Task_Image_Type);
|
||||
|
||||
Unspecified_Task_Info : constant Task_Info_Type := null;
|
||||
|
||||
end System.Task_Info;
|
||||
|
|
@ -1,52 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SELF --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1991-1998, 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 NetBSD/X86 (native) version of this package.
|
||||
|
||||
separate (System.Task_Primitives.Operations)
|
||||
|
||||
----------
|
||||
-- Self --
|
||||
----------
|
||||
|
||||
function Self return Task_ID is
|
||||
Temp : aliased System.Address;
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
begin
|
||||
Result := pthread_getspecific (ATCB_Key, Temp'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
return To_Task_ID (Temp);
|
||||
end Self;
|
||||
|
|
@ -1,100 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||
-- --
|
||||
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- --
|
||||
-- Copyright (C) 1991-2001, 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 NetBSD version of this package.
|
||||
|
||||
separate (System.Task_Primitives.Operations)
|
||||
package body Specific is
|
||||
|
||||
------------------
|
||||
-- Local Data --
|
||||
------------------
|
||||
|
||||
-- The followings are logically constants, but need to be initialized
|
||||
-- at run time.
|
||||
|
||||
ATCB_Key : aliased pthread_key_t;
|
||||
-- Key used to find the Ada Task_ID associated with a thread
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
procedure Initialize (Environment_Task : Task_ID) is
|
||||
Result : Interfaces.C.int;
|
||||
begin
|
||||
Result := pthread_key_create (ATCB_Key'Access, null);
|
||||
pragma Assert (Result = 0);
|
||||
Result := pthread_setspecific (ATCB_Key, To_Address (Environment_Task));
|
||||
pragma Assert (Result = 0);
|
||||
end Initialize;
|
||||
|
||||
---------
|
||||
-- Set --
|
||||
---------
|
||||
|
||||
procedure Set (Self_Id : Task_ID) is
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
begin
|
||||
Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id));
|
||||
pragma Assert (Result = 0);
|
||||
end Set;
|
||||
|
||||
----------
|
||||
-- Self --
|
||||
----------
|
||||
|
||||
function Self return Task_ID is
|
||||
Result : System.Address;
|
||||
|
||||
begin
|
||||
Result := pthread_getspecific (ATCB_Key);
|
||||
pragma Assert (Result /= System.Null_Address);
|
||||
return To_Task_Id (Result);
|
||||
end Self;
|
||||
|
||||
-------------------
|
||||
-- Is_Valid_Task --
|
||||
-------------------
|
||||
|
||||
function Is_Valid_Task return Boolean is
|
||||
begin
|
||||
return pthread_getspecific (ATCB_Key) /= System.Null_Address;
|
||||
end Is_Valid_Task;
|
||||
|
||||
|
||||
|
||||
end Specific;
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
#!/bin/sh
|
||||
# Wrapper to setup environment for using gcc 3.4 Ada compiler
|
||||
echo $@
|
||||
env \
|
||||
CC=@GCC_PREFIX@/bin/cc \
|
||||
CPP=@GCC_PREFIX@/bin/cpp \
|
||||
ADAC=@GCC_PREFIX@/bin/gcc \
|
||||
PATH=@GCC_PREFIX@/bin:${PATH} \
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
/* Binding to _lwp_self for the Ada RTS */
|
||||
#include <lwp.h>
|
||||
|
||||
lwpid_t ada_lwp_self(void) {
|
||||
return _lwp_self();
|
||||
}
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
#include <signal.h>
|
||||
|
||||
/* <signal.h> defines macros for a number of
|
||||
signal handling functions. Bindings are
|
||||
provided here, that expand the macros,
|
||||
for use by the Ada RTS. */
|
||||
|
||||
int adasigaddset(sigset_t *set, int signo) {
|
||||
return sigaddset(set, signo);
|
||||
}
|
||||
|
||||
int adasigdelset(sigset_t *set, int signo) {
|
||||
return sigdelset(set, signo);
|
||||
}
|
||||
|
||||
int adasigemptyset(sigset_t *set) {
|
||||
return sigemptyset(set);
|
||||
}
|
||||
|
||||
int adasigfillset(sigset_t *set) {
|
||||
return sigfillset(set);
|
||||
}
|
||||
|
||||
int adasigismember(sigset_t *set, int signo) {
|
||||
return sigismember(set, signo);
|
||||
}
|
||||
|
||||
int adasigaction(int sig, const struct sigaction *act, struct sigaction *oact) {
|
||||
return sigaction(sig, act, oact);
|
||||
}
|
||||
|
||||
int adasigwait(const sigset_t *set, int *sig) {
|
||||
return sigwait(set, sig);
|
||||
}
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,30 +0,0 @@
|
|||
#include <pthread.h>
|
||||
#include <errno.h>
|
||||
|
||||
/* These are some dummy replacements for functions missing in the pthread library */
|
||||
|
||||
int pthread_mutexattr_setprotocol(pthread_mutexattr_t *attr, int protocol) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int pthread_mutexattr_getprioceiling(const pthread_mutexattr_t *attr, int *prioceiling) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int
|
||||
pthread_setschedparam(pthread_t thread, int policy,
|
||||
const struct sched_param *param)
|
||||
{
|
||||
if (param == NULL || policy < SCHED_FIFO || policy > SCHED_RR)
|
||||
return EINVAL;
|
||||
if (param->sched_priority > 0 || policy != SCHED_RR)
|
||||
return ENOTSUP;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
int pthread_mutexattr_setprioceiling(pthread_mutexattr_t *attr,
|
||||
int prioceiling)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -1,301 +0,0 @@
|
|||
-- MACRO.DFS
|
||||
-- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS.
|
||||
-- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR,
|
||||
-- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS
|
||||
-- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE
|
||||
-- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4,
|
||||
-- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT,
|
||||
-- AND BLANKS). THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE
|
||||
-- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB.
|
||||
|
||||
-- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED
|
||||
-- IN THIS FILE IS $MAX_IN_LEN. THE NEXT 5 MACRO DEFINITIONS
|
||||
-- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF
|
||||
-- MAX_IN_LEN. THESE ARE IN ALPHABETIC ORDER. FOLLOWING THESE
|
||||
-- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER.
|
||||
|
||||
-- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT:
|
||||
|
||||
-- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --.
|
||||
-- THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS
|
||||
-- IN THE TEST FILES (WITH THE DOLLAR SIGN). THE NEXT FEW "COMMENT"
|
||||
-- LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED.
|
||||
-- THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE
|
||||
-- WORDS "USED IN: " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES
|
||||
-- (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS.
|
||||
-- EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS.
|
||||
-- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE
|
||||
-- IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL,
|
||||
-- FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE
|
||||
-- SUBSTITUTED. IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS
|
||||
-- PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO
|
||||
-- THE IMPLEMENTATION.
|
||||
|
||||
-- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES.
|
||||
-- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE.
|
||||
|
||||
-- $MAX_IN_LEN
|
||||
-- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE
|
||||
-- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE
|
||||
-- CHARACTER).
|
||||
-- USED IN: A26007A
|
||||
MAX_IN_LEN 200
|
||||
|
||||
-- $MAX_STRING_LITERAL
|
||||
-- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE
|
||||
-- QUOTE CHARACTERS).
|
||||
-- USED IN: A26007A
|
||||
MAX_STRING_LITERAL "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
|
||||
|
||||
-- $BIG_ID1
|
||||
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
|
||||
-- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE
|
||||
-- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'.
|
||||
-- USED IN: C23003A C23003B C23003G C23003I
|
||||
-- C35502D C35502F
|
||||
BIG_ID1 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1
|
||||
|
||||
-- $BIG_ID2
|
||||
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
|
||||
-- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER. THE MACROSUB
|
||||
-- PROGRAM WILL USE '2' AS THE LAST CHARACTER.
|
||||
-- USED IN: C23003A C23003B B23003F C23003G C23003I
|
||||
BIG_ID2 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2
|
||||
|
||||
-- $BIG_ID3
|
||||
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
|
||||
-- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'.
|
||||
-- USED IN: C23003A C23003B C23003G C23003I
|
||||
BIG_ID3 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
|
||||
|
||||
-- $BIG_ID4
|
||||
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
|
||||
-- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER. MACROSUB
|
||||
-- WILL USE '4' AS THE MIDDLE CHARACTER.
|
||||
-- USED IN: C23003A C23003B C23003G C23003I
|
||||
BIG_ID4 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
|
||||
|
||||
-- $BIG_STRING1
|
||||
-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2
|
||||
-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
|
||||
-- USED IN: C35502D C35502F
|
||||
BIG_STRING1 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
|
||||
|
||||
-- $BIG_STRING2
|
||||
-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1
|
||||
-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
|
||||
-- USED IN: C35502D C35502F
|
||||
BIG_STRING2 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1"
|
||||
|
||||
-- $BLANKS
|
||||
-- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS.
|
||||
-- USED IN: B22001A B22001B B22001C B22001D B22001E B22001F
|
||||
-- B22001G B22001I B22001J B22001K B22001L B22001M
|
||||
-- B22001N
|
||||
-- < LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS >
|
||||
BLANKS
|
||||
|
||||
-- $ACC_SIZE
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS
|
||||
-- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE.
|
||||
-- USED IN: CD2A83C BD2A02A
|
||||
ACC_SIZE 64
|
||||
|
||||
-- $ALIGNMENT
|
||||
-- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE.
|
||||
-- USED IN: CD4041A BD4006A
|
||||
ALIGNMENT 4
|
||||
|
||||
-- $COUNT_LAST
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST.
|
||||
-- USED IN: CE3002B
|
||||
COUNT_LAST 2147483647
|
||||
|
||||
-- $ENTRY_ADDRESS
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
|
||||
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.
|
||||
-- USED IN: SPPRT13SP
|
||||
ENTRY_ADDRESS ENTRY_ADDR
|
||||
|
||||
-- $ENTRY_ADDRESS1
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
|
||||
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS
|
||||
-- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS.
|
||||
-- USED IN: SPPRT13SP
|
||||
ENTRY_ADDRESS1 ENTRY_ADDR1
|
||||
|
||||
-- $ENTRY_ADDRESS2
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
|
||||
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS
|
||||
-- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS
|
||||
-- AND $ENTRY_ADDRESS1.
|
||||
-- USED IN: SPPRT13SP
|
||||
ENTRY_ADDRESS2 ENTRY_ADDR2
|
||||
|
||||
-- $FIELD_LAST
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST.
|
||||
-- USED IN: CE3002C
|
||||
FIELD_LAST 255
|
||||
|
||||
-- $FORM_STRING
|
||||
-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH
|
||||
-- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
|
||||
-- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE
|
||||
-- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH
|
||||
-- FOR THE FILE.
|
||||
-- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE
|
||||
-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE
|
||||
-- OF THE CONDITIONS. IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION,
|
||||
-- THEN SUBSTITUTE THE NULL STRING ("").
|
||||
-- USED IN: CE3304A
|
||||
FORM_STRING ""
|
||||
|
||||
-- $FORM_STRING2
|
||||
-- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS
|
||||
-- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION
|
||||
-- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL
|
||||
-- "CANNOT_RESTRICT_FILE_CAPACITY".
|
||||
-- USED IN: CE2203A CE2403A
|
||||
FORM_STRING2 "CANNOT_RESTRICT_FILE_CAPACITY"
|
||||
|
||||
-- $GREATER_THAN_DURATION
|
||||
-- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR
|
||||
-- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST. IF
|
||||
-- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE.
|
||||
-- USED IN: C96005B
|
||||
GREATER_THAN_DURATION 86_000.0
|
||||
|
||||
|
||||
|
||||
|
||||
-- $ILLEGAL_EXTERNAL_FILE_NAME1
|
||||
-- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID
|
||||
-- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A
|
||||
-- NONEXISTENT DIRECTORY).
|
||||
-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B CE3107A
|
||||
ILLEGAL_EXTERNAL_FILE_NAME1 /NODIRECTORY/FILENAME
|
||||
|
||||
-- $ILLEGAL_EXTERNAL_FILE_NAME2
|
||||
-- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1.
|
||||
-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B
|
||||
ILLEGAL_EXTERNAL_FILE_NAME2 /@@/@@/@@\@@\@@\@@
|
||||
|
||||
-- $INAPPROPRIATE_LINE_LENGTH
|
||||
-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH
|
||||
-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1.
|
||||
-- USED IN: CE3304A
|
||||
INAPPROPRIATE_LINE_LENGTH -1
|
||||
|
||||
-- $INAPPROPRIATE_PAGE_LENGTH
|
||||
-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
|
||||
-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1.
|
||||
-- USED IN: CE3304A
|
||||
INAPPROPRIATE_PAGE_LENGTH -1
|
||||
|
||||
-- $INTEGER_FIRST
|
||||
-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST.
|
||||
-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
|
||||
-- BLANKS.
|
||||
-- USED IN: C35503F B54B01B
|
||||
INTEGER_FIRST -2147483648
|
||||
|
||||
-- $INTEGER_LAST
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST. THE LITERAL MUST
|
||||
-- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS.
|
||||
-- USED IN: C35503F B54B01B
|
||||
INTEGER_LAST 2147483647
|
||||
|
||||
|
||||
-- $LESS_THAN_DURATION
|
||||
-- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO
|
||||
-- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND
|
||||
-- DURATION'FIRST. IF NO SUCH VALUES EXIST, USE A VALUE IN
|
||||
-- DURATION'RANGE.
|
||||
-- USED IN: C96005B
|
||||
LESS_THAN_DURATION -86_400.0
|
||||
|
||||
|
||||
-- $MACHINE_CODE_STATEMENT
|
||||
-- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE
|
||||
-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE
|
||||
-- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ).
|
||||
-- USED IN: AD8011A BD8001A BD8002A BD8004A BD8004B
|
||||
MACHINE_CODE_STATEMENT Asm_Insn'(Asm ("nop"));
|
||||
|
||||
-- $MAX_INT
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT.
|
||||
-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
|
||||
-- BLANKS.
|
||||
-- USED IN: C35503D C35503F C4A007A
|
||||
MAX_INT 9223372036854775807
|
||||
|
||||
|
||||
-- $MIN_INT
|
||||
-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT.
|
||||
-- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING
|
||||
-- BLANKS.
|
||||
-- USED IN: C35503D C35503F
|
||||
MIN_INT -9223372036854775808
|
||||
|
||||
-- $NAME
|
||||
-- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
|
||||
-- SHORT_INTEGER, OR LONG_INTEGER.
|
||||
-- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED
|
||||
-- IDENTIFIER SUCH AS NO_SUCH_TYPE_AVAILABLE.)
|
||||
-- USED IN: C45231D CD7101G
|
||||
NAME LONG_LONG_INTEGER
|
||||
|
||||
-- $OPTIONAL_DISC
|
||||
-- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME.
|
||||
-- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE
|
||||
-- NO_SUCH_MACHINE_CODE_DISC.
|
||||
-- USED IN: BD8002A
|
||||
OPTIONAL_DISC
|
||||
|
||||
-- $RECORD_DEFINITION
|
||||
-- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT
|
||||
-- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE
|
||||
-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE,
|
||||
-- THEN USE A NULL RECORD DEFINITION
|
||||
-- USED IN: BD8002A
|
||||
RECORD_DEFINITION RECORD ASM : STRING (1..4); END RECORD;
|
||||
|
||||
-- $RECORD_NAME
|
||||
-- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE.
|
||||
-- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN
|
||||
-- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE"
|
||||
-- USED IN: BD8002A
|
||||
RECORD_NAME Asm_Insn
|
||||
|
||||
-- $TASK_SIZE
|
||||
-- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO
|
||||
-- HOLD A TASK OBJECT.
|
||||
-- USED IN: CD2A91C
|
||||
TASK_SIZE 64
|
||||
|
||||
-- $TASK_STORAGE_SIZE
|
||||
-- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION.
|
||||
-- USED IN: BD2C01D BD2C02A BD2C03A C87B62D CD1009K CD1009T
|
||||
-- CD1009U CD1C03E CD1C06A CD2C11A CC1225A CD2C11D
|
||||
TASK_STORAGE_SIZE 65536
|
||||
|
||||
-- $VARIABLE_ADDRESS
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
|
||||
-- IMPLEMENTATION.
|
||||
-- USED IN: SPPRT13SP
|
||||
VARIABLE_ADDRESS VAR_ADDR
|
||||
|
||||
-- $VARIABLE_ADDRESS1
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
|
||||
-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THAT USED IN
|
||||
-- THE MACRO $VARIABLE_ADDRESS.
|
||||
-- USED IN: SPPRT13SP
|
||||
VARIABLE_ADDRESS1 VAR_ADDR1
|
||||
|
||||
-- $VARIABLE_ADDRESS2
|
||||
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
|
||||
-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN
|
||||
-- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1.
|
||||
-- USED IN: SPPRT13SP
|
||||
VARIABLE_ADDRESS2 VAR_ADDR2
|
||||
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
# Create compiler driver scripts in ${WRKDIR}.
|
||||
(test -d ${WRKDIR}/.gcc/bin || ${MKDIR} ${WRKDIR}/.gcc/bin)
|
||||
(cd ${BUILDLINK_PREFIX.gcc34-ada}/bin && bin_files=`${FIND} . -type f \( -perm -0100 \)` && \
|
||||
cd ${WRKDIR}/.gcc/bin && \
|
||||
for _target_ in $${bin_files} ; do \
|
||||
${ECHO} '#!${TOOLS_SHELL}' > $${_target_} && \
|
||||
${ECHO} -n "exec ${BUILDLINK_PREFIX.gcc34-ada}/bin/$${_target_}" >> $${_target_} && \
|
||||
${ECHO} ' "$$@"' >> $${_target_} && \
|
||||
${CHMOD} +x $${_target_}; \
|
||||
done )
|
||||
Loading…
Reference in a new issue