Commit 366b8af7 by Robert Dewar Committed by Arnaud Charlet

a-taster.adb, [...]: Minor reformatting.

2008-03-26  Robert Dewar  <dewar@adacore.com>

	* a-taster.adb, s-shasto.adb, s-soflin.adb, s-taasde.adb, s-taenca.adb,
	a-sytaco.adb, a-sytaco.ads, a-tasatt.adb, a-taside.adb,
	a-intnam-lynxos.ads, a-retide.adb, a-intnam-tru64.ads, a-intnam-aix.ads,
	a-intnam-irix.ads, a-intnam-hpux.ads, a-intnam-linux.ads,
	a-intnam-solaris.ads, a-caldel-vms.adb, a-intnam-vms.ads,
	a-excpol-abort.adb, a-intnam-mingw.ads, s-interr.adb, s-interr.ads,
	s-intman.ads, s-gloloc.adb, s-osinte-lynxos-3.ads,
	s-interr-sigaction.adb, s-osinte-hpux.ads, s-osinte-solaris-posix.ads,
	a-intnam-freebsd.ads, s-osinte-freebsd.ads, s-osinte-lynxos.ads,
	s-taspri-lynxos.ads, s-osinte-tru64.ads, s-osinte-tru64.ads,
	s-taspri-tru64.ads, s-osinte-aix.ads, s-osinte-irix.ads,
	s-osinte-hpux-dce.ads, s-taprop-hpux-dce.adb, s-taspri-hpux-dce.ads,
	s-osinte-linux.ads, s-osinte-dummy.ads, s-taprop-dummy.adb,
	s-taspri-dummy.ads, s-interr-dummy.adb, s-osinte-solaris.ads,
	s-osinte-mingw.ads, s-taprop-solaris.adb, s-taspri-solaris.ads,
	s-inmaop-vms.adb, s-interr-vms.adb, s-intman-vms.ads, s-osinte-vms.ads,
	s-osinte-vms.ads, s-taprop-vms.adb, s-taspri-vms.ads,
	s-taspri-mingw.ads, s-interr-vxworks.adb, s-inmaop-posix.adb,
	s-intman-vxworks.ads, s-osinte-vxworks.ads, s-osprim-vxworks.adb,
	s-taspri-vxworks.ads, s-taspri-posix.ads, a-caldel.adb, a-calend.adb,
	a-elchha.adb, a-dynpri.adb, a-except.adb, a-except.ads, a-interr.ads,
	a-textio.adb, a-tigeau.ads, atree.adb, s-taprob.adb, s-taprop.ads,
	s-tarest.adb, s-tarest.ads, s-tasini.adb, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasren.adb, s-tasren.ads, s-tassta.adb, s-tassta.ads,
	s-tasuti.adb, s-tataat.adb, s-tataat.ads, s-tpoben.adb, s-tpoben.ads,
	s-tpobop.adb, s-tpobop.ads, s-tposen.adb, s-tposen.ads, s-valrea.adb,
	s-valuti.adb, a-intnam-darwin.ads, s-osinte-darwin.ads, s-solita.adb,
	a-ztinau.ads, s-osinte-linux-hppa.ads, a-except-2005.adb,
	a-except-2005.ads, a-rttiev.adb, s-osinte-vxworks6.ads, s-regexp.adb,
	s-tasloc.adb: Minor reformatting.
	Update comments.
	Remove "used for" sections from comments.

From-SVN: r133546
parent 4e0ede3d
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -35,10 +35,7 @@
-- This is the Alpha/VMS version
with System.OS_Primitives;
-- Used for Max_Sensible_Delay
with System.Soft_Links;
-- Used for Timed_Delay
package body Ada.Calendar.Delays is
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2006, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -33,17 +33,9 @@
------------------------------------------------------------------------------
with System.OS_Primitives;
-- Used for Delay_Modes
-- Max_Sensible_Delay
with System.Soft_Links;
-- Used for Timed_Delay
with System.Traces;
-- Used for Send_Trace_Info
with System.Parameters;
-- used for Runtime_Traces
package body Ada.Calendar.Delays is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -34,7 +34,6 @@
with Ada.Unchecked_Conversion;
with System.OS_Primitives;
-- used for Clock
package body Ada.Calendar is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,21 +32,9 @@
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
-- Set_Priority
-- Wakeup
-- Self
with System.Tasking;
-- used for Task_Id
with System.Parameters;
-- used for Single_Lock
with System.Soft_Links;
-- use for Abort_Defer
-- Abort_Undefer
with Ada.Unchecked_Conversion;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2008, 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- --
......@@ -38,11 +38,7 @@ pragma Compiler_Unit;
pragma Warnings (On);
with System.Standard_Library; use System.Standard_Library;
-- Used for Adafinal
with System.Soft_Links;
-- Used for Task_Termination_Handler
-- Task_Termination_NT
procedure Ada.Exceptions.Last_Chance_Handler
(Except : Exception_Occurrence)
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -31,16 +31,14 @@
-- --
------------------------------------------------------------------------------
-- This version is used for all Ada 2005 builds. It differs from a-except.ads
-- only with respect to the addition of Wide_[Wide]Exception_Name functions.
-- This version of Ada.Exceptions fully supports both Ada 95 and Ada 2005.
-- It is used in all situations except for the build of the compiler and
-- other basic tools. For these latter builds, we use an Ada 95-only version.
-- The reason for this splitting off of a separate version is that bootstrap
-- compilers often will be used that do not support Ada 2005 features, and
-- Ada.Exceptions is part of the compiler sources.
-- The base version of this unit Ada.Exceptions omits the Wide version of
-- Exception_Name and is used to build the compiler and other basic tools.
pragma Style_Checks (All_Checks);
-- No subprogram ordering check, due to logical grouping
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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 --
......@@ -35,18 +35,14 @@
-- --
------------------------------------------------------------------------------
-- This version is used for all Ada 2005 builds. It differs from a-except.ads
-- only with respect to the addition of Wide_[Wide]Exception_Name functions.
-- The additional entities are marked with pragma Ada_05, so this extended
-- unit is also perfectly suitable for use in Ada 95 or Ada 83 mode.
-- This version of Ada.Exceptions fully supports both Ada 95 and Ada 2005.
-- It is used in all situations except for the build of the compiler and
-- other basic tools. For these latter builds, we use an Ada 95-only version.
-- The reason for this splitting off of a separate version is that bootstrap
-- compilers often will be used that do not support Ada 2005 features, and
-- Ada.Exceptions is part of the compiler sources.
-- The base version of this unit Ada.Exceptions omits the Wide version of
-- Exception_Name and is used to build the compiler and other basic tools.
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with ourself.
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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 --
......
......@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -45,7 +45,6 @@ pragma Warnings (Off);
-- It is safe in the context of the run-time to violate the rules!
with System.Soft_Links;
-- used for Check_Abort_Status
pragma Warnings (On);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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 --
......@@ -36,7 +36,6 @@
------------------------------------------------------------------------------
with System.Interrupts;
-- used for Ada_Interrupt_ID
package Ada.Interrupts is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -51,13 +51,12 @@
-- supported by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
-- Beware that the mapping of names to signals may be many-to-one. There
-- may be aliases. Also, for all signal names that are not supported on the
-- current system the value of the corresponding constant will be zero.
-- 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
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -45,7 +45,6 @@
-- supported by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......@@ -53,100 +52,100 @@ package Ada.Interrupts.Names is
-- 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 :=
SIGHUP : constant Interrupt_ID :=
System.OS_Interface.SIGHUP; -- hangup
SIGINT : constant Interrupt_ID :=
SIGINT : constant Interrupt_ID :=
System.OS_Interface.SIGINT; -- interrupt (rubout)
SIGQUIT : constant Interrupt_ID :=
SIGQUIT : constant Interrupt_ID :=
System.OS_Interface.SIGQUIT; -- quit (ASCD FS)
SIGILL : constant Interrupt_ID :=
SIGILL : constant Interrupt_ID :=
System.OS_Interface.SIGILL; -- illegal instruction (not reset)
SIGTRAP : constant Interrupt_ID :=
SIGTRAP : constant Interrupt_ID :=
System.OS_Interface.SIGTRAP; -- trace trap (not reset)
SIGIOT : constant Interrupt_ID :=
SIGIOT : constant Interrupt_ID :=
System.OS_Interface.SIGIOT; -- IOT instruction
SIGABRT : constant Interrupt_ID := -- used by abort,
SIGABRT : constant Interrupt_ID := -- used by abort,
System.OS_Interface.SIGABRT; -- replace SIGIOT in the future
SIGEMT : constant Interrupt_ID :=
SIGEMT : constant Interrupt_ID :=
System.OS_Interface.SIGEMT; -- EMT instruction
SIGFPE : constant Interrupt_ID :=
SIGFPE : constant Interrupt_ID :=
System.OS_Interface.SIGFPE; -- floating point exception
SIGKILL : constant Interrupt_ID :=
SIGKILL : constant Interrupt_ID :=
System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored)
SIGBUS : constant Interrupt_ID :=
SIGBUS : constant Interrupt_ID :=
System.OS_Interface.SIGBUS; -- bus error
SIGSEGV : constant Interrupt_ID :=
SIGSEGV : constant Interrupt_ID :=
System.OS_Interface.SIGSEGV; -- segmentation violation
SIGSYS : constant Interrupt_ID :=
SIGSYS : constant Interrupt_ID :=
System.OS_Interface.SIGSYS; -- bad argument to system call
SIGPIPE : constant Interrupt_ID := -- write on a pipe with
SIGPIPE : constant Interrupt_ID := -- write on a pipe with
System.OS_Interface.SIGPIPE; -- no one to read it
SIGALRM : constant Interrupt_ID :=
SIGALRM : constant Interrupt_ID :=
System.OS_Interface.SIGALRM; -- alarm clock
SIGTERM : constant Interrupt_ID :=
SIGTERM : constant Interrupt_ID :=
System.OS_Interface.SIGTERM; -- software termination signal from kill
SIGURG : constant Interrupt_ID :=
SIGURG : constant Interrupt_ID :=
System.OS_Interface.SIGURG; -- urgent condition on IO channel
SIGSTOP : constant Interrupt_ID :=
SIGSTOP : constant Interrupt_ID :=
System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored)
SIGTSTP : constant Interrupt_ID :=
SIGTSTP : constant Interrupt_ID :=
System.OS_Interface.SIGTSTP; -- user stop requested from tty
SIGCONT : constant Interrupt_ID :=
SIGCONT : constant Interrupt_ID :=
System.OS_Interface.SIGCONT; -- stopped process has been continued
SIGCHLD : constant Interrupt_ID :=
SIGCHLD : constant Interrupt_ID :=
System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD
SIGTTIN : constant Interrupt_ID :=
SIGTTIN : constant Interrupt_ID :=
System.OS_Interface.SIGTTIN; -- background tty read attempted
SIGTTOU : constant Interrupt_ID :=
SIGTTOU : constant Interrupt_ID :=
System.OS_Interface.SIGTTOU; -- background tty write attempted
SIGIO : constant Interrupt_ID := -- input/output possible,
SIGIO : constant Interrupt_ID := -- input/output possible,
System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris)
SIGXCPU : constant Interrupt_ID :=
SIGXCPU : constant Interrupt_ID :=
System.OS_Interface.SIGXCPU; -- CPU time limit exceeded
SIGXFSZ : constant Interrupt_ID :=
SIGXFSZ : constant Interrupt_ID :=
System.OS_Interface.SIGXFSZ; -- filesize limit exceeded
SIGVTALRM : constant Interrupt_ID :=
System.OS_Interface.SIGVTALRM; -- virtual timer expired
SIGPROF : constant Interrupt_ID :=
SIGPROF : constant Interrupt_ID :=
System.OS_Interface.SIGPROF; -- profiling timer expired
SIGWINCH : constant Interrupt_ID :=
SIGWINCH : constant Interrupt_ID :=
System.OS_Interface.SIGWINCH; -- window size change
SIGINFO : constant Interrupt_ID :=
SIGINFO : constant Interrupt_ID :=
System.OS_Interface.SIGINFO; -- information request
SIGUSR1 : constant Interrupt_ID :=
SIGUSR1 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR1; -- user defined signal 1
SIGUSR2 : constant Interrupt_ID :=
SIGUSR2 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR2; -- user defined signal 2
end Ada.Interrupts.Names;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -34,10 +34,13 @@
-- This is the FreeBSD THREADS 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
......@@ -128,9 +131,4 @@ package Ada.Interrupts.Names is
SIGUSR2 : constant Interrupt_ID :=
System.OS_Interface.SIGUSR2; -- user defined signal 2
-- 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.
end Ada.Interrupts.Names;
......@@ -6,8 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1991-2008, 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- --
......@@ -47,14 +46,12 @@
-- supported by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
-- Beware that the mapping of names to signals may be
-- many-to-one. There may be aliases. Also, for all
-- signal names that are not supported on the current system
-- the value of the corresponding constant will be zero.
-- 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
......
......@@ -6,8 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1991-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU Library General Public License as published by the --
......@@ -53,14 +52,12 @@
-- supported by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
-- Beware that the mapping of names to signals may be
-- many-to-one. There may be aliases. Also, for all
-- signal names that are not supported on the current system
-- the value of the corresponding constant will be zero.
-- 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
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -51,7 +51,6 @@
-- supported by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -43,7 +43,6 @@
-- SIGINT: made available for Ada handler
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2008, 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- --
......@@ -37,7 +37,6 @@
-- by the local system.
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......@@ -45,22 +44,22 @@ package Ada.Interrupts.Names is
-- 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.
SIGINT : constant Interrupt_ID :=
System.OS_Interface.SIGINT; -- interrupt (rubout)
SIGINT : constant Interrupt_ID := -- interrupt (rubout)
System.OS_Interface.SIGINT;
SIGILL : constant Interrupt_ID :=
System.OS_Interface.SIGILL; -- illegal instruction (not reset)
SIGILL : constant Interrupt_ID := -- illegal instruction (not reset)
System.OS_Interface.SIGILL;
SIGABRT : constant Interrupt_ID := -- used by abort,
System.OS_Interface.SIGABRT; -- replace SIGIOT in the future
SIGABRT : constant Interrupt_ID := -- used by abort (use SIGIOT in future)
System.OS_Interface.SIGABRT;
SIGFPE : constant Interrupt_ID :=
System.OS_Interface.SIGFPE; -- floating point exception
SIGFPE : constant Interrupt_ID := -- floating point exception
System.OS_Interface.SIGFPE;
SIGSEGV : constant Interrupt_ID :=
System.OS_Interface.SIGSEGV; -- segmentation violation
SIGSEGV : constant Interrupt_ID := -- segmentation violation
System.OS_Interface.SIGSEGV;
SIGTERM : constant Interrupt_ID :=
System.OS_Interface.SIGTERM; -- software termination signal from kill
SIGTERM : constant Interrupt_ID := -- software termination signal from kill
System.OS_Interface.SIGTERM;
end Ada.Interrupts.Names;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -48,7 +48,6 @@
-- SIGINT: made available for Ada handlers
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -43,7 +43,6 @@
-- SIGINT: made available for Ada handler
with System.OS_Interface;
-- used for names of interrupts
package Ada.Interrupts.Names is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -37,6 +37,7 @@
-- supported by the local system.
with System.OS_Interface;
package Ada.Interrupts.Names is
package OS renames System.OS_Interface;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,15 +32,9 @@
------------------------------------------------------------------------------
with Ada.Exceptions;
-- Used for Raise_Exception
with System.Tasking;
-- Used for Task_Id
-- Initialize
with System.Task_Primitives.Operations;
-- Used for Timed_Delay
-- Self
package body Ada.Real_Time.Delays is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2008, 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- --
......@@ -34,7 +34,6 @@
with System.Task_Primitives.Operations;
with System.Tasking.Utilities;
with System.Soft_Links;
-- used for Abort_Defer/Undefer
with Ada.Containers.Doubly_Linked_Lists;
pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists);
......@@ -46,7 +45,6 @@ pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists);
package body Ada.Real_Time.Timing_Events is
use System.Task_Primitives.Operations;
-- for Write_Lock and Unlock
package SSL renames System.Soft_Links;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -31,20 +31,10 @@
-- --
------------------------------------------------------------------------------
with System.Tasking;
-- Used for Detect_Blocking
-- Self
with Ada.Exceptions;
-- Used for Raise_Exception
with System.Tasking;
with System.Task_Primitives.Operations;
-- Used for Initialize
-- Finalize
-- Current_State
-- Set_False
-- Set_True
-- Suspend_Until_True
package body Ada.Synchronous_Task_Control is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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 --
......@@ -36,10 +36,8 @@
------------------------------------------------------------------------------
with System.Task_Primitives;
-- Used for Suspension_Object
with Ada.Finalization;
-- Used for Limited_Controlled
package Ada.Synchronous_Task_Control is
pragma Preelaborate_05;
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -222,39 +222,13 @@
-- instantiated from within a local context.
with System.Error_Reporting;
-- Used for Shutdown;
with System.Storage_Elements;
-- Used for Integer_Address
with System.Task_Primitives.Operations;
-- Used for Write_Lock
-- Unlock
-- Lock/Unlock_RTS
with System.Tasking;
-- Used for Access_Address
-- Task_Id
-- Direct_Index_Vector
-- Direct_Index
with System.Tasking.Initialization;
-- Used for Defer_Abort
-- Undefer_Abort
-- Initialize_Attributes_Link
-- Finalize_Attributes_Link
with System.Tasking.Task_Attributes;
-- Used for Access_Node
-- Access_Dummy_Wrapper
-- Deallocator
-- Instance
-- Node
-- Access_Instance
with Ada.Exceptions;
-- Used for Raise_Exception
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -43,7 +43,6 @@ pragma Warnings (Off);
-- It is safe in the context of the run-time to violate the rules!
with System.Tasking.Utilities;
-- Used for Abort_Tasks
pragma Warnings (On);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2008, 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- --
......@@ -32,21 +32,9 @@
------------------------------------------------------------------------------
with System.Tasking;
-- used for Task_Id
with System.Task_Primitives.Operations;
-- used for Self
-- Write_Lock
-- Unlock
-- Lock_RTS
-- Unlock_RTS
with System.Parameters;
-- used for Single_Lock
with System.Soft_Links;
-- use for Abort_Defer
-- Abort_Undefer
with Ada.Unchecked_Conversion;
......
......@@ -1037,7 +1037,7 @@ package body Ada.Text_IO is
Item := ASCII.NUL;
-- If we are before an upper half character just return it (this can
-- happen if there are two calls to Look_Ahead in a row.
-- happen if there are two calls to Look_Ahead in a row).
elsif File.Before_Upper_Half_Character then
End_Of_Line := False;
......@@ -2253,7 +2253,7 @@ begin
Standard_In.Is_Text_File := True;
Standard_In.Access_Method := 'T';
Standard_In.Self := Standard_In;
Standard_In.WC_Method := Default_WCEM;
Standard_In.WC_Method := Default_WCEM;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -178,7 +178,7 @@ private package Ada.Text_IO.Generic_Aux is
procedure String_Skip (Str : String; Ptr : out Integer);
-- Used in the Get from string procedures to skip leading blanks in the
-- string. Ptr is set to the index of the first non-blank. If the string
-- is all blanks, then the excption End_Error is raised, Note that blank
-- is all blanks, then the exception End_Error is raised, Note that blank
-- is defined as a space or horizontal tab (RM A.10.6(5)).
procedure Ungetc (ch : Integer; File : File_Type);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,10 +32,10 @@
------------------------------------------------------------------------------
-- This package contains the routines for Ada.Wide_Wide_Text_IO.Integer_IO
-- that are shared among separate instantiations of this package. The
-- routines in this package are identical semantically to those in Integer_IO
-- itself, except that the generic parameter Num has been replaced by Integer
-- or Long_Long_Integer, and the default parameters have been removed because
-- that are shared among separate instantiations of this package. The routines
-- in this package are identical semantically to those in Integer_IO itself,
-- except that the generic parameter Num has been replaced by Integer or
-- Long_Long_Integer, and the default parameters have been removed because
-- they are supplied explicitly by the calls from within the generic template.
private package Ada.Wide_Wide_Text_IO.Integer_Aux is
......
......@@ -2738,12 +2738,13 @@ package body Atree is
if Field2 (Cur_Node) not in Node_Range then
return Traverse_Field (Cur_Node, Field2 (Cur_Node), 2);
elsif Is_Syntactic_Field (Nkind (Cur_Node), 2) and then
Field2 (Cur_Node) /= Empty_List_Or_Node
elsif Is_Syntactic_Field (Nkind (Cur_Node), 2)
and then Field2 (Cur_Node) /= Empty_List_Or_Node
then
-- Here is the tail recursion step, we reset Cur_Node and jump
-- back to the start of the procedure, which has the same
-- semantic effect as a call.
-- Here is the tail recursion step, we reset Cur_Node and jump back
-- to the start of the procedure, which has the same semantic effect
-- as a call.
Cur_Node := Node_Id (Field2 (Cur_Node));
goto Tail_Recurse;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2008, 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- --
......@@ -32,7 +32,6 @@
------------------------------------------------------------------------------
with System.Soft_Links;
-- used for Lock_Task, Unlock_Task
package body System.Global_Locks is
......
......@@ -2,13 +2,12 @@
-- --
-- GNAT 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 . --
-- O P E R A T I O N S --
-- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -33,20 +32,14 @@
-- --
------------------------------------------------------------------------------
-- This is a POSIX-like version of this package.
-- Note: this file can only be used for POSIX compliant systems.
-- This is a POSIX-like version of this package
-- Note: this file can only be used for POSIX compliant systems
with Interfaces.C;
-- used for int
-- size_t
-- unsigned
with System.OS_Interface;
-- used for various type, constant, and operations
with System.Storage_Elements;
-- used for To_Address
-- Integer_Address
package body System.Interrupt_Management.Operations is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -34,19 +34,11 @@
-- This is a OpenVMS/Alpha version of this package
with System.OS_Interface;
-- used for various type, constant, and operations
with System.Aux_DEC;
-- used for Short_Address
with System.Parameters;
with System.Tasking;
with System.Tasking.Initialization;
with System.Task_Primitives.Operations;
with System.Task_Primitives.Operations.DEC;
with Ada.Unchecked_Conversion;
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2007, AdaCore --
-- --
-- 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- --
......@@ -34,8 +34,6 @@
-- This version is for systems that do not support interrupts (or signals)
with Ada.Exceptions;
package body System.Interrupts is
pragma Warnings (Off); -- kill warnings on unreferenced formals
......@@ -293,9 +291,7 @@ package body System.Interrupts is
procedure Unimplemented is
begin
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "interrupts/signals not implemented");
raise Program_Error;
raise Program_Error with "interrupts/signals not implemented";
end Unimplemented;
end System.Interrupts;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2008, 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- --
......@@ -34,47 +34,22 @@
-- This is the IRIX & NT version of this package
with Ada.Task_Identification;
-- used for Task_Id
with Ada.Unchecked_Conversion;
with Ada.Exceptions;
-- used for Raise_Exception
with Interfaces.C;
with System.Storage_Elements;
-- used for To_Address
-- To_Integer
with System.Task_Primitives.Operations;
-- used for Self
-- Sleep
-- Wakeup
-- Write_Lock
-- Unlock
with System.Tasking.Utilities;
-- used for Make_Independent
with System.Tasking.Rendezvous;
-- used for Call_Simple
with System.Tasking.Initialization;
-- used for Defer_Abort
-- Undefer_Abort
with System.Interrupt_Management;
with System.Parameters;
-- used for Single_Lock
with Interfaces.C;
-- used for int
with Ada.Unchecked_Conversion;
package body System.Interrupts is
use Parameters;
use Tasking;
use Ada.Exceptions;
use System.OS_Interface;
use Interfaces.C;
......@@ -183,8 +158,8 @@ package body System.Interrupts is
function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
Raise_Exception (Program_Error'Identity, "Interrupt" &
Interrupt_ID'Image (Interrupt) & " is reserved");
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Descriptors (Interrupt).T /= Null_Task;
......@@ -197,11 +172,11 @@ package body System.Interrupts is
function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
Raise_Exception (Program_Error'Identity, "Interrupt" &
Interrupt_ID'Image (Interrupt) & " is reserved");
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
else
return Descriptors (Interrupt).Kind /= Unknown;
end if;
return Descriptors (Interrupt).Kind /= Unknown;
end Is_Handler_Attached;
----------------
......@@ -370,9 +345,9 @@ package body System.Interrupts is
or else not Is_Registered (New_Handler))
then
Raise_Exception (Program_Error'Identity,
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler");
"dynamic Handler";
end if;
if Handlers (Interrupt) = null then
......@@ -420,12 +395,12 @@ package body System.Interrupts is
-- In case we have an Interrupt Entry already installed.
-- raise a program error. (propagate it to the caller).
Raise_Exception (Program_Error'Identity,
"An interrupt is already installed");
end if;
raise Program_Error with "An interrupt is already installed";
Old_Handler := Current_Handler (Interrupt);
Attach_Handler (New_Handler, Interrupt, Static);
else
Old_Handler := Current_Handler (Interrupt);
Attach_Handler (New_Handler, Interrupt, Static);
end if;
end Exchange_Handler;
--------------------
......@@ -442,13 +417,12 @@ package body System.Interrupts is
end if;
if Descriptors (Interrupt).Kind = Task_Entry then
Raise_Exception (Program_Error'Identity,
"Trying to detach an Interrupt Entry");
raise Program_Error with "Trying to detach an Interrupt Entry";
end if;
if not Static and then Descriptors (Interrupt).Static then
Raise_Exception (Program_Error'Identity,
"Trying to detach a static Interrupt Handler");
raise Program_Error with
"Trying to detach a static Interrupt Handler";
end if;
Descriptors (Interrupt) :=
......@@ -548,8 +522,8 @@ package body System.Interrupts is
end if;
if Descriptors (Interrupt).Kind /= Unknown then
Raise_Exception (Program_Error'Identity,
"A binding for this interrupt is already present");
raise Program_Error with
"A binding for this interrupt is already present";
end if;
if Handlers (Interrupt) = null then
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -56,54 +56,31 @@
-- any time.
-- Within this package, the lock L is used to protect the various status
-- tables. If there is a Server_Task associated with a signal or interrupt,
-- we use the per-task lock of the Server_Task instead so that we protect the
-- status between Interrupt_Manager and Server_Task. Protection among
-- service requests are ensured via user calls to the Interrupt_Manager
-- entries.
-- tables. If there is a Server_Task associated with a signal or interrupt, we
-- use the per-task lock of the Server_Task instead so that we protect the
-- status between Interrupt_Manager and Server_Task. Protection among service
-- requests are ensured via user calls to the Interrupt_Manager entries.
-- This is the VxWorks version of this package, supporting vectored hardware
-- interrupts.
with Ada.Unchecked_Conversion;
with System.OS_Interface; use System.OS_Interface;
with Interfaces.VxWorks;
with Ada.Task_Identification;
-- used for Task_Id type
with Ada.Exceptions;
-- used for Raise_Exception
with Interfaces.VxWorks;
with System.OS_Interface; use System.OS_Interface;
with System.Interrupt_Management;
-- used for Reserve
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
-- Abort
-- Wakeup_Task
-- Sleep
-- Initialize_Lock
with System.Storage_Elements;
-- used for To_Address
-- To_Integer
-- Integer_Address
with System.Tasking.Utilities;
-- used for Make_Independent
with System.Tasking.Rendezvous;
-- used for Call_Simple
pragma Elaborate_All (System.Tasking.Rendezvous);
package body System.Interrupts is
use Tasking;
use Ada.Exceptions;
package POP renames System.Task_Primitives.Operations;
......@@ -310,9 +287,8 @@ package body System.Interrupts is
procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
Raise_Exception
(Program_Error'Identity,
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved");
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
else
return;
end if;
......@@ -744,9 +720,7 @@ package body System.Interrupts is
procedure Unimplemented (Feature : String) is
begin
Raise_Exception
(Program_Error'Identity,
Feature & " not implemented on VxWorks");
raise Program_Error with Feature & " not implemented on VxWorks";
end Unimplemented;
-----------------------
......@@ -823,8 +797,8 @@ package body System.Interrupts is
-- If an interrupt entry is installed raise
-- Program_Error. (propagate it to the caller).
Raise_Exception (Program_Error'Identity,
"An interrupt entry is already installed");
raise Program_Error with
"An interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. This is the
......@@ -836,8 +810,8 @@ package body System.Interrupts is
-- Trying to detach a static Interrupt Handler. raise
-- Program_Error.
Raise_Exception (Program_Error'Identity,
"Trying to detach a static Interrupt Handler");
raise Program_Error with
"Trying to detach a static Interrupt Handler";
end if;
Old_Handler := User_Handler (Interrupt).H;
......@@ -869,9 +843,7 @@ package body System.Interrupts is
-- If an interrupt entry is already installed, raise
-- Program_Error. (propagate it to the caller).
Raise_Exception
(Program_Error'Identity,
"An interrupt is already installed");
raise Program_Error with "An interrupt is already installed";
end if;
-- Note : A null handler with Static = True will
......@@ -892,10 +864,9 @@ package body System.Interrupts is
or else not Is_Registered (New_Handler))
then
Raise_Exception
(Program_Error'Identity,
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler");
"dynamic Handler";
end if;
-- Save the old handler
......@@ -1003,9 +974,8 @@ package body System.Interrupts is
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
Raise_Exception
(Program_Error'Identity,
"A binding for this interrupt is already present");
raise Program_Error with
"A binding for this interrupt is already present";
end if;
User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -35,24 +35,19 @@
-- Any changes to this interface may require corresponding compiler changes.
-- This package encapsulates the implementation of interrupt or signal
-- handlers. It is logically an extension of the body of Ada.Interrupts.
-- It is made a child of System to allow visibility of various
-- runtime system internal data and operations.
-- handlers. It is logically an extension of the body of Ada.Interrupts. It
-- is made a child of System to allow visibility of various runtime system
-- internal data and operations.
-- See System.Interrupt_Management for core interrupt/signal interfaces
-- These two packages are separated in order to allow
-- System.Interrupt_Management to be used without requiring the whole
-- tasking implementation to be linked and elaborated.
-- These two packages are separated to allow System.Interrupt_Management to be
-- used without requiring the whole tasking implementation to be linked and
-- elaborated.
with System.Tasking;
-- used for Task_Id
with System.Tasking.Protected_Objects.Entries;
-- used for Protection_Entries
with System.OS_Interface;
-- used for Max_Interrupt
package System.Interrupts is
......@@ -73,11 +68,9 @@ package System.Interrupts is
type Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
-- The following renaming is introduced so that the type is accessible
-- through rtsfind, otherwise the name clashes with its homonym in
-- ada.interrupts.
subtype System_Interrupt_Id is Interrupt_ID;
-- This synonym is introduced so that the type is accessible through
-- rtsfind, otherwise the name clashes with its homonym in Ada.Interrupts.
type Parameterless_Handler is access protected procedure;
......@@ -97,10 +90,10 @@ package System.Interrupts is
function Current_Handler
(Interrupt : Interrupt_ID) return Parameterless_Handler;
-- Calling the following procedures with New_Handler = null
-- and Static = true means that we want to modify the current handler
-- regardless of the previous handler's binding status.
-- (i.e. we do not care whether it is a dynamic or static handler)
-- Calling the following procedures with New_Handler = null and Static =
-- true means that we want to modify the current handler regardless of the
-- previous handler's binding status. (i.e. we do not care whether it is a
-- dynamic or static handler)
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
......@@ -150,8 +143,8 @@ package System.Interrupts is
function Unblocked_By
(Interrupt : Interrupt_ID) return System.Tasking.Task_Id;
-- It returns the ID of the last Task which Unblocked this Interrupt.
-- It returns Null_Task if no tasks have ever requested the
-- Unblocking operation or the Interrupt is currently Blocked.
-- It returns Null_Task if no tasks have ever requested the Unblocking
-- operation or the Interrupt is currently Blocked.
function Is_Blocked (Interrupt : Interrupt_ID) return Boolean;
-- Comment needed ???
......@@ -169,9 +162,9 @@ package System.Interrupts is
-- other low-level interface that changes the signal action or signal mask
-- needs a careful thought.
-- One may acheive the effect of system calls first making RTS blocked
-- (by calling Block_Interrupt) for the signal under consideration.
-- This will make all the tasks in RTS blocked for the Interrupt.
-- One may acheive the effect of system calls first making RTS blocked (by
-- calling Block_Interrupt) for the signal under consideration. This will
-- make all the tasks in RTS blocked for the Interrupt.
----------------------
-- Protection Types --
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -48,8 +48,6 @@
-- implemented as visible arrays rather than functions.)
with System.OS_Interface;
-- used for Signal
-- sigset_t
package System.Interrupt_Management is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -48,10 +48,8 @@
-- sets are implemeneted using visible arrays rather than functions.
with System.OS_Interface;
-- used for sigset_t
with Interfaces.C;
-- used for int
package System.Interrupt_Management is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -46,10 +46,8 @@
-- rather than functions.
with System.OS_Interface;
-- used for sigset_t
with Interfaces.C;
-- used for int
package System.Interrupt_Management is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,14 +35,15 @@
-- This is a AIX (Native THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services that are
-- needed by children of System.
-- needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,12 +35,13 @@
-- This is Darwin pthreads version of this package
-- This package includes all direct interfaces to OS services that are needed
-- by children of System.
-- by the tasking run-time (libgnarl).
-- 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;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -36,14 +36,15 @@
-- This is the FreeBSD PTHREADS version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,14 +35,15 @@
-- This is the HP-UX version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -34,18 +34,16 @@
-- This is a HPUX 11.0 (Native THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services that are
-- needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -34,15 +34,16 @@
-- This is the SGI Pthreads version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services that are
-- needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -8,7 +8,7 @@
-- (GNU/Linux-HPPA Version) --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,15 +35,16 @@
-- This is a GNU/Linux (GNU/LinuxThreads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services that are
-- needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,14 +35,15 @@
-- This is a GNU/Linux (GNU/LinuxThreads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,14 +35,15 @@
-- This is a LynxOS (Native) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,14 +35,15 @@
-- This is a LynxOS (POSIX Threads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,13 +35,15 @@
-- This is a NT (native) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Unchecked_Conversion;
package System.OS_Interface is
......@@ -75,6 +77,8 @@ package System.OS_Interface is
type PLONG is access all Interfaces.C.long;
type PDWORD is access all DWORD;
type BYTE is new Interfaces.C.unsigned_char;
subtype CHAR is Interfaces.C.char;
type BOOL is new Boolean;
for BOOL'Size use Interfaces.C.unsigned_long'Size;
......@@ -95,6 +99,19 @@ package System.OS_Interface is
NO_ERROR : constant := 0;
FUNC_ERR : constant := -1;
-----------
-- Files --
-----------
type SECURITY_ATTRIBUTES is record
nLength : DWORD;
pSecurityDescriptor : PVOID;
bInheritHandle : BOOL;
end record;
function CloseHandle (hObject : HANDLE) return BOOL;
pragma Import (Stdcall, CloseHandle, "CloseHandle");
------------------------
-- System Information --
------------------------
......@@ -259,30 +276,22 @@ package System.OS_Interface is
function To_PTHREAD_START_ROUTINE is new
Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
type SECURITY_ATTRIBUTES is record
nLength : DWORD;
pSecurityDescriptor : PVOID;
bInheritHandle : BOOL;
end record;
type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES;
function CreateThread
(pThreadAttributes : PSECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : PVOID;
dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
(pThreadAttributes : access SECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : PVOID;
dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
pragma Import (Stdcall, CreateThread, "CreateThread");
function BeginThreadEx
(pThreadAttributes : PSECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : PVOID;
dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
(pThreadAttributes : access SECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : PVOID;
dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
pragma Import (C, BeginThreadEx, "_beginthreadex");
Debug_Process : constant := 16#00000001#;
......@@ -373,11 +382,8 @@ package System.OS_Interface is
-- Semaphores, Events and Mutexes --
------------------------------------
function CloseHandle (hObject : HANDLE) return BOOL;
pragma Import (Stdcall, CloseHandle, "CloseHandle");
function CreateSemaphore
(pSemaphoreAttributes : PSECURITY_ATTRIBUTES;
(pSemaphoreAttributes : access SECURITY_ATTRIBUTES;
lInitialCount : Interfaces.C.long;
lMaximumCount : Interfaces.C.long;
pName : PSZ) return HANDLE;
......@@ -396,7 +402,7 @@ package System.OS_Interface is
pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
function CreateEvent
(pEventAttributes : PSECURITY_ATTRIBUTES;
(pEventAttributes : access SECURITY_ATTRIBUTES;
bManualReset : BOOL;
bInitialState : BOOL;
pName : PSZ) return HANDLE;
......@@ -418,7 +424,7 @@ package System.OS_Interface is
pragma Import (Stdcall, PulseEvent, "PulseEvent");
function CreateMutex
(pMutexAttributes : PSECURITY_ATTRIBUTES;
(pMutexAttributes : access SECURITY_ATTRIBUTES;
bInitialOwner : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, CreateMutex, "CreateMutexA");
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,12 +35,13 @@
-- This is a Solaris (POSIX Threads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
package System.OS_Interface is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,12 +35,13 @@
-- This is a Solaris (native) version of this package
-- This package includes all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
package System.OS_Interface is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -32,15 +32,16 @@
-- --
------------------------------------------------------------------------------
-- This is the DEC Unix 4.0/5.1 version of this package
-- This is the Tru64 version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
package System.OS_Interface is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,13 +35,15 @@
-- This is a OpenVMS/Alpha version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Ada.Unchecked_Conversion;
with System.Aux_DEC;
package System.OS_Interface is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,12 +35,13 @@
-- This is the VxWorks version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with System.VxWorks;
package System.OS_Interface is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2008, 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- --
......@@ -35,7 +35,7 @@
-- This is the VxWorks 6.x version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- that are needed by the tasking run-time (libgnarl).
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
......@@ -135,12 +135,12 @@ package System.OS_Interface is
-- Signal processing definitions --
-----------------------------------
-- The how in sigprocmask().
-- The how in sigprocmask()
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;
-- The sa_flags in struct sigaction.
-- The sa_flags in struct sigaction
SA_SIGINFO : constant := 16#0002#;
SA_ONSTACK : constant := 16#0004#;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2008, 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- --
......@@ -40,7 +40,6 @@ with System.OS_Interface;
-- create a dependency on libgnarl in libgnat, which is not desirable.
with Interfaces.C;
-- used for type int
package body System.OS_Primitives is
......
......@@ -31,7 +31,6 @@
-- --
------------------------------------------------------------------------------
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Streams;
......@@ -483,10 +482,8 @@ package body System.Shared_Storage is
-- Error if we cannot create the file
when others =>
Ada.Exceptions.Raise_Exception
(Program_Error'Identity,
"Cannot create shared variable file for """ &
S & '"'); -- "
raise Program_Error with
"Cannot create shared variable file for """ & S & '"';
end;
end;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -36,15 +36,13 @@ pragma Compiler_Unit;
pragma Warnings (On);
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- an infinite loop from the code within the Poll routine itself.
-- We must turn polling off for this unit, because otherwise we get an
-- infinite loop from the code within the Poll routine itself.
with System.Parameters;
-- Used for Sec_Stack_Ratio
pragma Warnings (Off);
-- Disable warnings since System.Secondary_Stack is currently not
-- Preelaborate
-- Disable warnings since System.Secondary_Stack is currently not Preelaborate
with System.Secondary_Stack;
pragma Warnings (On);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2008, 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- --
......@@ -32,31 +32,20 @@
------------------------------------------------------------------------------
pragma Style_Checks (All_Checks);
-- Turn off subprogram alpha ordering check, since we group soft link
-- bodies and dummy soft link bodies together separately in this unit.
-- Turn off subprogram alpha ordering check, since we group soft link bodies
-- and dummy soft link bodies together separately in this unit.
pragma Polling (Off);
-- Turn polling off for this package. We don't need polling during any
-- of the routines in this package, and more to the point, if we try
-- to poll it can cause infinite loops.
-- Turn polling off for this package. We don't need polling during any of the
-- routines in this package, and more to the point, if we try to poll it can
-- cause infinite loops.
with System.Task_Primitives.Operations;
-- Used for Self
-- Timed_Delay
with Ada.Exceptions;
with Ada.Exceptions.Is_Null_Occurrence;
with System.Task_Primitives.Operations;
with System.Tasking;
-- Used for Task_Id
-- Cause_Of_Termination
with System.Stack_Checking;
-- Used for Stack_Access
with Ada.Exceptions;
-- Used for Exception_Id
-- Exception_Occurrence
-- Save_Occurrence
with Ada.Exceptions.Is_Null_Occurrence;
package body System.Soft_Links.Tasking is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2008, 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- --
......@@ -35,46 +35,17 @@ 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 Ada.Exceptions;
-- Used for Raise_Exception
with Ada.Unchecked_Conversion;
with Ada.Task_Identification;
with System.Task_Primitives.Operations;
-- Used for Write_Lock,
-- Unlock,
-- Self,
-- Monotonic_Clock,
-- Self,
-- Timed_Sleep,
-- Wakeup,
-- Yield
with System.Tasking.Utilities;
-- Used for Make_Independent
with System.Tasking.Initialization;
-- Used for Defer_Abort
-- Undefer_Abort
with System.Tasking.Debug;
-- Used for Trace
with System.OS_Primitives;
-- used for Max_Sensible_Delay
with Ada.Task_Identification;
-- used for Task_Id type
with System.Interrupt_Management.Operations;
-- used for Setup_Interrupt_Mask
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
with System.Traces.Tasking;
-- used for Send_Trace_Info
with Ada.Unchecked_Conversion;
package body System.Tasking.Async_Delays is
......@@ -228,8 +199,7 @@ package body System.Tasking.Async_Delays is
"async delay from within abort-deferred region");
if Self_Id.ATC_Nesting_Level = ATC_Level'Last then
Ada.Exceptions.Raise_Exception (Storage_Error'Identity,
"not enough ATC nesting levels");
raise Storage_Error with "not enough ATC nesting levels";
end if;
Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,36 +32,13 @@
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for STPO.Write_Lock
-- Unlock
-- STPO.Get_Priority
-- Sleep
-- Timed_Sleep
with System.Tasking.Initialization;
-- used for Change_Base_Priority
-- Defer_Abort/Undefer_Abort
with System.Tasking.Protected_Objects.Entries;
-- used for To_Protection
with System.Tasking.Protected_Objects.Operations;
-- used for PO_Service_Entries
with System.Tasking.Queuing;
-- used for Requeue_Call_With_New_Prio
-- Onqueue
-- Dequeue_Call
with System.Tasking.Utilities;
-- used for Exit_One_ATC_Level
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
with System.Traces;
-- used for Send_Trace_Info
package body System.Tasking.Entry_Calls is
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2006, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -37,19 +37,9 @@ pragma Polling (Off);
-- tasking operations. It causes infinite loops and other problems.
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
-- Self
-- Set_Ceiling
with System.Parameters;
-- used for Runtime_Traces
with System.Traces;
-- used for Send_Trace_Info
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
package body System.Tasking.Protected_Objects is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -33,15 +33,14 @@
-- This is a no tasking version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Error_Reporting;
-- used for Shutdown
package body System.Task_Primitives.Operations is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -33,50 +33,34 @@
-- This is a HP-UX DCE threads (HPUX 10) version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Tasking.Debug;
-- used for Known_Tasks
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
with System.Tasking.Debug;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with System.OS_Primitives;
with System.Task_Primitives.Interrupt_Operations;
pragma Warnings (Off);
with System.Interrupt_Management.Operations;
-- used for Set_Interrupt_Mask
-- All_Tasks_Mask
pragma Elaborate_All (System.Interrupt_Management.Operations);
pragma Warnings (On);
with System.OS_Primitives;
-- used for Delay_Modes
with Interfaces.C;
-- used for int
-- size_t
with System.Task_Primitives.Interrupt_Operations;
-- used for Get_Interrupt_ID
with System.Soft_Links;
-- used for Defer/Undefer_Abort
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later is a higher level package that we shouldn't depend on.
-- For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -33,47 +33,32 @@
-- This is a Solaris (native) version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Tasking.Debug;
-- used for Known_Tasks
with Ada.Unchecked_Deallocation;
with System.Interrupt_Management;
-- used for Keep_Unmasked
-- Abort_Task_Interrupt
-- Interrupt_ID
with Interfaces.C;
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.OS_Primitives;
-- used for Delay_Modes
with System.Task_Info;
pragma Warnings (Off);
with System.OS_Lib;
-- used for String_Access, Getenv
pragma Warnings (On);
with Interfaces.C;
-- used for int
-- size_t
with System.Task_Info;
-- to initialize Task_Info for a C thread, in function Self
with System.Soft_Links;
-- used for Defer/Undefer_Abort
-- We use System.Soft_Links instead of System.Tasking.Initialization
-- because the later is a higher level package that we shouldn't depend on.
-- For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -33,32 +33,22 @@
-- This is a OpenVMS/Alpha version of this package
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Tasking.Debug;
-- used for Known_Tasks
with System.OS_Primitives;
-- used for Delay_Modes
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
-- used for int
-- size_t
with System.Tasking.Debug;
with System.OS_Primitives;
with System.Soft_Links;
-- used for Get_Exc_Stack_Addr
-- Abort_Defer/Undefer
with System.Aux_DEC;
-- used for Short_Address
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body System.Task_Primitives.Operations is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -31,17 +31,12 @@
-- --
------------------------------------------------------------------------------
-- This package contains all the GNULL primitives that interface directly
-- with the underlying OS.
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
with System.Parameters;
-- used for Size_Type
with System.Tasking;
-- used for Task_Id
with System.OS_Interface;
-- used for Thread_Id
package System.Task_Primitives.Operations is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2008, 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- --
......@@ -46,31 +46,18 @@ pragma Polling (Off);
-- tasking operations. It causes infinite loops and other problems.
with Ada.Exceptions;
-- used for Exception_Occurrence
with System.Task_Primitives.Operations;
-- used for Enter_Task
-- Write_Lock
-- Unlock
-- Wakeup
-- Get_Priority
with System.Soft_Links;
-- used for the non-tasking routines (*_NT) that refer to global data.
-- They are needed here before the tasking run time has been elaborated.
-- used for Create_TSD
-- This package also provides initialization routines for task specific data.
-- The GNARL must call these to be sure that all non-tasking
-- Ada constructs will work.
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
with System.Secondary_Stack;
-- used for SS_Init;
with System.Storage_Elements;
-- used for Storage_Array;
with System.Soft_Links;
-- Used for the non-tasking routines (*_NT) that refer to global data. They
-- are needed here before the tasking run time has been elaborated. used for
-- Create_TSD This package also provides initialization routines for task
-- specific data. The GNARL must call these to be sure that all non-tasking
-- Ada constructs will work.
package body System.Tasking.Restricted.Stages is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -46,10 +46,7 @@
-- System.Protected_Objects.Single_Entry
with System.Task_Info;
-- used for Task_Info_Type
with System.Parameters;
-- used for Size_Type
package System.Tasking.Restricted.Stages is
pragma Elaborate_Body;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,38 +32,22 @@
------------------------------------------------------------------------------
pragma Style_Checks (All_Checks);
-- Turn off subprogram alpha ordering check, since we group soft link
-- bodies and dummy soft link bodies together separately in this unit.
-- Turn off subprogram alpha ordering check, since we group soft link bodies
-- and dummy soft link bodies together separately in this unit.
pragma Polling (Off);
-- Turn polling off for this package. We don't need polling during any
-- of the routines in this package, and more to the point, if we try
-- to poll it can cause infinite loops.
-- Turn polling off for this package. We don't need polling during any of the
-- routines in this package, and more to the point, if we try to poll it can
-- cause infinite loops.
with Ada.Exceptions;
-- Used for Exception_Occurrence_Access
with System.Task_Primitives;
-- Used for Lock
with System.Task_Primitives.Operations;
-- Used for Set_Priority
-- Write_Lock
-- Unlock
-- Initialize_Lock
with System.Soft_Links;
-- Used for the non-tasking routines (*_NT) that refer to global data.
-- They are needed here before the tasking run time has been elaborated.
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
with System.Tasking.Debug;
-- Used for Trace
with System.Parameters;
-- used for Single_Lock
package body System.Tasking.Initialization is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,14 +32,11 @@
------------------------------------------------------------------------------
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Task_Primitives.Operations;
-- used for Self
with System.Storage_Elements;
-- Needed for initializing Stack_Info.Size
package body System.Tasking is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -37,25 +37,13 @@
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Exceptions;
-- Used for Exception_Id
-- Exception_Occurrence
with Ada.Unchecked_Conversion;
with System.Parameters;
-- used for Size_Type
with System.Task_Info;
-- used for Task_Info_Type
with System.Soft_Links;
-- used for TSD
with System.Task_Primitives;
-- used for Private_Data
with System.Stack_Usage;
-- used for Stack_Analyzer
with Ada.Unchecked_Conversion;
package System.Tasking is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2007, AdaCore --
-- Copyright (C) 1997-2008, AdaCore --
-- --
-- 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- --
......@@ -32,7 +32,6 @@
------------------------------------------------------------------------------
with System.Soft_Links;
-- used for Lock_Task, Unlock_Task
package body System.Task_Lock is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -34,8 +34,8 @@
-- This is a no tasking version of this package
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -36,13 +36,10 @@
-- This package provides low-level support for most tasking features
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -35,13 +35,10 @@
-- This is a LynxOS version of this package, derived from s-taspri-posix.ads
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -34,13 +34,10 @@
-- This is a NT (native) version of this package
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -37,13 +37,10 @@
-- Note: this file can only be used for POSIX compliant systems
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -36,16 +36,13 @@
-- This package provides low-level support for most tasking features
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 System.OS_Interface;
-- used for mutex_t
-- cond_t
-- thread_t
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with Ada.Unchecked_Conversion;
with System.OS_Interface;
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -36,17 +36,12 @@
-- This package provides low-level support for most tasking features
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.
-- 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;
-- used for int
-- size_t
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2008, 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- --
......@@ -36,17 +36,12 @@
-- This package provides low-level support for most tasking features
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.
-- 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;
-- used for int
-- size_t
with System.OS_Interface;
-- used for pthread_mutex_t
-- pthread_cond_t
-- pthread_t
package System.Task_Primitives is
pragma Preelaborate;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2006 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2008, 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- --
......@@ -34,8 +34,8 @@
-- This is a VxWorks version of this package
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.OS_Interface;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -31,19 +31,13 @@
-- --
------------------------------------------------------------------------------
-- This version of the body implements queueing policy according to the
-- policy specified by the pragma Queuing_Policy. When no such pragma
-- is specified FIFO policy is used as default.
-- This version of the body implements queueing policy according to the policy
-- specified by the pragma Queuing_Policy. When no such pragma is specified
-- FIFO policy is used as default.
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
with System.Tasking.Initialization;
-- used for Wakeup_Entry_Caller
with System.Parameters;
-- used for Single_Lock
package body System.Tasking.Queuing is
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,53 +32,15 @@
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Get_Priority
-- Set_Priority
-- Write_Lock
-- Unlock
-- Sleep
-- Wakeup
-- Timed_Sleep
with System.Tasking.Entry_Calls;
-- Used for Wait_For_Completion
-- Wait_For_Completion_With_Timeout
-- Wait_Until_Abortable
with System.Tasking.Initialization;
-- used for Defer_Abort
-- Undefer_Abort
-- Do_Pending_Action
with System.Tasking.Queuing;
-- used for Enqueue
-- Dequeue_Head
-- Select_Task_Entry_Call
-- Count_Waiting
with System.Tasking.Utilities;
-- used for Check_Exception
-- Make_Passive
-- Wakeup_Entry_Caller
-- Exit_One_ATC_Level
with System.Tasking.Protected_Objects.Operations;
-- used for PO_Do_Or_Queue
-- PO_Service_Entries
-- Lock_Entries
with System.Tasking.Debug;
-- used for Trace
with System.Restrictions;
-- used for Abort_Allowed
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
with System.Traces.Tasking;
-- used for Send_Trace_Info
package body System.Tasking.Rendezvous is
......@@ -402,8 +364,7 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then STPO.Self.Common.Protected_Action_Nesting > 0
then
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
raise Program_Error with "potentially blocking operation";
end if;
Call_Synchronous
......@@ -1037,8 +998,7 @@ package body System.Tasking.Rendezvous is
end if;
Initialization.Undefer_Abort (Self_Id);
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "Entry call not a delay mode");
raise Program_Error with "Entry call not a delay mode";
end if;
end case;
......@@ -1351,8 +1311,7 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
raise Program_Error with "potentially blocking operation";
end if;
if Parameters.Runtime_Traces then
......@@ -1719,8 +1678,7 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
raise Program_Error with "potentially blocking operation";
end if;
Initialization.Defer_Abort (Self_Id);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -35,10 +35,8 @@
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Exceptions;
-- Used for, Exception_Id
with System.Tasking.Protected_Objects.Entries;
-- used for Protection_Entries
package System.Tasking.Rendezvous is
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -37,14 +37,12 @@
-- Note: Only the compiler is allowed to use this interface, by generating
-- direct calls to it, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes
-- in exp_ch9.adb and possibly exp_ch7.adb
with System.Task_Info;
-- used for Task_Info_Type
with System.Parameters;
-- used for Size_Type
package System.Tasking.Stages is
pragma Elaborate_Body;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -31,39 +31,20 @@
-- --
------------------------------------------------------------------------------
-- This package provides RTS Internal Declarations.
-- This package provides RTS Internal Declarations
-- These declarations are not part of the GNARLI
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.
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
with System.Tasking.Debug;
-- used for Known_Tasks
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Wakeup
-- Unlock
-- Sleep
-- Abort_Task
-- Lock/Unlock_RTS
with System.Tasking.Initialization;
-- Used for Defer_Abort
-- Undefer_Abort
-- Locked_Abort_To_Level
with System.Tasking.Queuing;
-- used for Dequeue_Call
-- Dequeue_Head
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
with System.Traces.Tasking;
-- used for Send_Trace_Info
package body System.Tasking.Utilities is
......@@ -129,8 +110,7 @@ package body System.Tasking.Utilities is
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
raise Program_Error with "potentially blocking operation";
end if;
Initialization.Defer_Abort_Nestable (Self_Id);
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -32,16 +32,10 @@
-- --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
-- Lock/Unlock_RTS
with Ada.Unchecked_Conversion;
with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
-- used for Defer_Abort
-- Undefer_Abort
with Ada.Unchecked_Conversion;
package body System.Tasking.Task_Attributes is
......
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, AdaCore --
-- Copyright (C) 1995-2008, AdaCore --
-- --
-- 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- --
......@@ -35,10 +35,8 @@
-- This package provides support for the body of Ada.Task_Attributes
with Ada.Finalization;
-- Used for Limited_Controlled
with System.Storage_Elements;
-- Used for Integer_Address
package System.Tasking.Task_Attributes is
......
......@@ -2,12 +2,11 @@
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
-- E N T R I E S --
-- SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES --
-- --
-- B o d y --
-- B o d y --
-- --
-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2008, 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- --
......@@ -44,32 +43,13 @@
-- Note: the compiler generates direct calls to this interface, via Rtsfind
with Ada.Exceptions;
-- Used for Exception_Occurrence_Access
-- Raise_Exception
with System.Task_Primitives.Operations;
-- Used for Initialize_Lock
-- Write_Lock
-- Unlock
-- Get_Priority
-- Wakeup
-- Set_Ceiling
with System.Restrictions;
with System.Parameters;
with System.Tasking.Initialization;
-- Used for Defer_Abort,
-- Undefer_Abort,
-- Change_Base_Priority
pragma Elaborate_All (System.Tasking.Initialization);
-- This insures that tasking is initialized if any protected objects are
-- created.
with System.Restrictions;
-- Used for Abort_Allowed
with System.Parameters;
-- Used for Single_Lock
-- To insure that tasking is initialized if any protected objects are created
package body System.Tasking.Protected_Objects.Entries is
......@@ -77,7 +57,6 @@ package body System.Tasking.Protected_Objects.Entries is
use Parameters;
use Task_Primitives.Operations;
use Ada.Exceptions;
----------------
-- Local Data --
......@@ -126,7 +105,7 @@ package body System.Tasking.Protected_Objects.Entries is
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation");
raise Program_Error with "Ceiling Violation";
end if;
if Single_Lock then
......@@ -246,8 +225,7 @@ package body System.Tasking.Protected_Objects.Entries is
is
begin
if Object.Finalized then
Raise_Exception
(Program_Error'Identity, "Protected Object is finalized");
raise Program_Error with "Protected Object is finalized";
end if;
-- If pragma Detect_Blocking is active then, as described in the ARM
......@@ -306,7 +284,7 @@ package body System.Tasking.Protected_Objects.Entries is
Lock_Entries (Object, Ceiling_Violation);
if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation");
raise Program_Error with "Ceiling Violation";
end if;
end Lock_Entries;
......@@ -319,8 +297,7 @@ package body System.Tasking.Protected_Objects.Entries is
begin
if Object.Finalized then
Raise_Exception
(Program_Error'Identity, "Protected Object is finalized");
raise Program_Error with "Protected Object is finalized";
end if;
-- If pragma Detect_Blocking is active then, as described in the ARM
......@@ -345,7 +322,7 @@ package body System.Tasking.Protected_Objects.Entries is
Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
Raise_Exception (Program_Error'Identity, "Ceiling Violation");
raise Program_Error with "Ceiling Violation";
end if;
-- We are entering in a protected action, so that we increase the
......
......@@ -2,12 +2,11 @@
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
-- E N T R I E S --
-- SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,11 +31,13 @@
-- --
------------------------------------------------------------------------------
-- This package contains all the simple primitives related to
-- Protected_Objects with entries (i.e init, lock, unlock).
-- This package contains all simple primitives related to Protected_Objects
-- with entries (i.e init, lock, unlock).
-- The handling of protected objects with no entries is done in
-- System.Tasking.Protected_Objects, the complex routines for protected
-- objects with entries in System.Tasking.Protected_Objects.Operations.
-- The split between Entries and Operations is needed to break circular
-- dependencies inside the run time.
......@@ -44,8 +45,6 @@
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Finalization;
-- used for Limited_Controlled
with Ada.Unchecked_Conversion;
package System.Tasking.Protected_Objects.Entries is
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment