+2010-10-12 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma
+ * gnat_rm.texi (pragma Suppress_All): Document new placement rules
+ * par-prag.adb (P_Pragma, case Suppress_All): Set
+ Has_Pragma_Suppress_All flag.
+ * sem_prag.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma
+ (Analyze_Pragma, case Suppress_All): Remove placement check
+ (Process_Compilation_Unit_Pragmas): Use Has_Pragma_Suppress_All flag
+ * sem_prag.ads (Process_Compilation_Unit_Pragmas): Update documentation
+ * sinfo.adb (Has_Pragma_Suppress_All): New flag
+ (Has_Pragma_Priority): New name for Has_Priority_Pragma
+ * sinfo.ads (Has_Pragma_Suppress_All): New flag
+ (Has_Pragma_Priority): New name for Has_Priority_Pragma
+
+2010-10-12 Arnaud Charlet <charlet@adacore.com>
+
+ * lib-xref.ads: Mark j/J as reserved for C++ classes.
+
+2010-10-12 Jose Ruiz <ruiz@adacore.com>
+
+ * a-exetim-default.ads, a-exetim-posix.adb: New.
+ * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for linux): Use the
+ POSIX Realtime support to implement CPU clocks.
+ (EXTRA_GNATRTL_TASKING_OBJS for linux): Add the a-exetim.o object
+ to the tasking library.
+ (THREADSLIB): Make the POSIX.1b Realtime Extensions library (librt)
+ available for shared libraries.
+ * gcc-interface/Make-lang.in: Update dependencies.
+
+2010-10-12 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch13.adb (Analyze_Aspect_Specifications): For Pre/Post, break
+ apart expressions with AND THEN clauses into separate pragmas.
+ * sinput.ads, sinput.adab (Get_Logical_Line_Number_Img): New function.
+
2010-10-12 Robert Dewar <dewar@adacore.com>
* par-ch13.adb (P_Aspect_Specifications): Fix handling of 'Class aspects
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . E X E C U T I O N _ T I M E --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2007-2010, Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the contents of the part following the private keyword. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Task_Identification;
+with Ada.Real_Time;
+
+package Ada.Execution_Time is
+
+ type CPU_Time is private;
+
+ CPU_Time_First : constant CPU_Time;
+ CPU_Time_Last : constant CPU_Time;
+ CPU_Time_Unit : constant := Ada.Real_Time.Time_Unit;
+ CPU_Tick : constant Ada.Real_Time.Time_Span;
+
+ function Clock
+ (T : Ada.Task_Identification.Task_Id
+ := Ada.Task_Identification.Current_Task)
+ return CPU_Time;
+
+ function "+"
+ (Left : CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time;
+
+ function "+"
+ (Left : Ada.Real_Time.Time_Span;
+ Right : CPU_Time) return CPU_Time;
+
+ function "-"
+ (Left : CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time;
+
+ function "-"
+ (Left : CPU_Time;
+ Right : CPU_Time) return Ada.Real_Time.Time_Span;
+
+ function "<" (Left, Right : CPU_Time) return Boolean;
+ function "<=" (Left, Right : CPU_Time) return Boolean;
+ function ">" (Left, Right : CPU_Time) return Boolean;
+ function ">=" (Left, Right : CPU_Time) return Boolean;
+
+ procedure Split
+ (T : CPU_Time;
+ SC : out Ada.Real_Time.Seconds_Count;
+ TS : out Ada.Real_Time.Time_Span);
+
+ function Time_Of
+ (SC : Ada.Real_Time.Seconds_Count;
+ TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
+ return CPU_Time;
+
+private
+
+ type CPU_Time is new Ada.Real_Time.Time;
+
+ CPU_Time_First : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_First);
+ CPU_Time_Last : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_Last);
+
+ CPU_Tick : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Tick;
+
+ pragma Import (Intrinsic, "<");
+ pragma Import (Intrinsic, "<=");
+ pragma Import (Intrinsic, ">");
+ pragma Import (Intrinsic, ">=");
+
+end Ada.Execution_Time;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . E X E C U T I O N _ T I M E --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2007-2010, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the POSIX (Realtime Extension) version of this package
+
+with Ada.Task_Identification; use Ada.Task_Identification;
+with Ada.Unchecked_Conversion;
+
+with System.OS_Interface; use System.OS_Interface;
+
+with Interfaces.C; use Interfaces.C;
+
+package body Ada.Execution_Time is
+
+ pragma Linker_Options ("-lrt");
+ -- POSIX.1b Realtime Extensions library. Needed to have access to function
+ -- clock_gettime.
+
+ ---------
+ -- "+" --
+ ---------
+
+ function "+"
+ (Left : CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ is
+ use type Ada.Real_Time.Time;
+ begin
+ return CPU_Time (Ada.Real_Time.Time (Left) + Right);
+ end "+";
+
+ function "+"
+ (Left : Ada.Real_Time.Time_Span;
+ Right : CPU_Time) return CPU_Time
+ is
+ use type Ada.Real_Time.Time;
+ begin
+ return CPU_Time (Left + Ada.Real_Time.Time (Right));
+ end "+";
+
+ ---------
+ -- "-" --
+ ---------
+
+ function "-"
+ (Left : CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ is
+ use type Ada.Real_Time.Time;
+ begin
+ return CPU_Time (Ada.Real_Time.Time (Left) - Right);
+ end "-";
+
+ function "-"
+ (Left : CPU_Time;
+ Right : CPU_Time) return Ada.Real_Time.Time_Span
+ is
+ use type Ada.Real_Time.Time;
+ begin
+ return (Ada.Real_Time.Time (Left) - Ada.Real_Time.Time (Right));
+ end "-";
+
+ -----------
+ -- Clock --
+ -----------
+
+ function Clock
+ (T : Ada.Task_Identification.Task_Id :=
+ Ada.Task_Identification.Current_Task)
+ return CPU_Time
+ is
+ TS : aliased timespec;
+ Result : Interfaces.C.int;
+
+ function To_CPU_Time is
+ new Ada.Unchecked_Conversion (Duration, CPU_Time);
+ -- Time is equal to Duration (although it is a private type) and
+ -- CPU_Time is equal to Time.
+
+ function clock_gettime
+ (clock_id : Interfaces.C.int;
+ tp : access timespec)
+ return int;
+ pragma Import (C, clock_gettime, "clock_gettime");
+ -- Function from the POSIX.1b Realtime Extensions library
+
+ CLOCK_THREAD_CPUTIME_ID : constant := 3;
+ -- Identifier for the clock returning per-task CPU time
+
+ begin
+ if T = Ada.Task_Identification.Null_Task_Id then
+ raise Program_Error;
+ end if;
+
+ Result := clock_gettime
+ (clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access);
+ pragma Assert (Result = 0);
+
+ return To_CPU_Time (To_Duration (TS));
+ end Clock;
+
+ -----------
+ -- Split --
+ -----------
+
+ procedure Split
+ (T : CPU_Time;
+ SC : out Ada.Real_Time.Seconds_Count;
+ TS : out Ada.Real_Time.Time_Span)
+ is
+ use type Ada.Real_Time.Time;
+ begin
+ Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
+ end Split;
+
+ -------------
+ -- Time_Of --
+ -------------
+
+ function Time_Of
+ (SC : Ada.Real_Time.Seconds_Count;
+ TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
+ return CPU_Time
+ is
+ begin
+ return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
+ end Time_Of;
+
+end Ada.Execution_Time;
-- Add the _Priority component if a Priority pragma is present
- if Present (Taskdef) and then Has_Priority_Pragma (Taskdef) then
+ if Present (Taskdef) and then Has_Pragma_Priority (Taskdef) then
declare
Prag : constant Node_Id :=
Find_Task_Or_Protected_Pragma (Taskdef, Name_Priority);
-- defined value, see D.3(10).
if Present (Pdef)
- and then Has_Priority_Pragma (Pdef)
+ and then Has_Pragma_Priority (Pdef)
then
declare
Prio : constant Node_Id :=
-- Priority parameter. Set to Unspecified_Priority unless there is a
-- priority pragma, in which case we take the value from the pragma.
- if Present (Tdef) and then Has_Priority_Pragma (Tdef) then
+ if Present (Tdef) and then Has_Pragma_Priority (Tdef) then
Append_To (Args,
Make_Selected_Component (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
- ada/casing.ads ada/debug.ads ada/einfo.ads ada/err_vars.ads \
- ada/erroutc.ads ada/erroutc.adb ada/hostparm.ads ada/interfac.ads \
- ada/namet.ads ada/namet.adb ada/nlists.ads ada/opt.ads ada/output.ads \
- ada/output.adb ada/rident.ads ada/sinfo.ads ada/sinput.ads \
- ada/sinput.adb ada/snames.ads ada/system.ads ada/s-exctab.ads \
- ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
- ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
- ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/targparm.ads ada/tree_io.ads ada/types.ads \
- ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
- ada/widechar.ads
+ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
+ ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
+ ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb ada/hostparm.ads \
+ ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads ada/opt.ads \
+ ada/output.ads ada/output.adb ada/rident.ads ada/sinfo.ads \
+ ada/sinput.ads ada/sinput.adb ada/snames.ads ada/system.ads \
+ ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+ ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
+ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+ ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
+ ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
+ ada/urealp.ads ada/widechar.ads
ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/instpar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
- ada/casing.ads ada/debug.ads ada/einfo.ads ada/gnatvsn.ads \
- ada/hostparm.ads ada/instpar.ads ada/instpar.adb ada/interfac.ads \
- ada/namet.ads ada/nlists.ads ada/opt.ads ada/output.ads \
- ada/sdefault.ads ada/sinfo.ads ada/sinput.ads ada/sinput.adb \
- ada/sinput-l.ads ada/snames.ads ada/system.ads ada/s-carun8.ads \
- ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
- ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
- ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/widechar.ads
+ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
+ ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
+ ada/gnatvsn.ads ada/hostparm.ads ada/instpar.ads ada/instpar.adb \
+ ada/interfac.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
+ ada/output.ads ada/sdefault.ads ada/sinfo.ads ada/sinput.ads \
+ ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/system.ads \
+ ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
+ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+ ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+ ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/interfac.o : ada/interfac.ads ada/system.ads
ada/unchdeal.ads ada/urealp.ads
ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
- ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
+ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
+ ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/gnat.ads \
ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads ada/hostparm.ads \
ada/interfac.ads ada/lib.ads ada/lib-writ.ads ada/namet.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \
- ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
+ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
+ ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
ada/osint.ads ada/osint-c.ads ada/output.ads ada/repinfo.ads \
ada/sem_aux.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
ada/urealp.ads
ada/tree_in.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
- ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \
- ada/csets.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
- ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
- ada/output.ads ada/repinfo.ads ada/sem_aux.ads ada/sinfo.ads \
- ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
- ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \
- ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
- ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/tree_in.ads ada/tree_in.adb ada/tree_io.ads ada/types.ads \
- ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
+ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
+ ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
+ ada/fname.ads ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
+ ada/opt.ads ada/output.ads ada/repinfo.ads ada/sem_aux.ads \
+ ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/stand.ads \
+ ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
+ ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
+ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+ ada/table.adb ada/tree_in.ads ada/tree_in.adb ada/tree_io.ads \
+ ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
+ ada/urealp.ads
ada/tree_io.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/debug.ads ada/hostparm.ads ada/output.ads \
THREADSLIB = -lmarte
else
LIBGNAT_TARGET_PAIRS += \
+ a-exetim.adb<a-exetim-posix.adb \
+ a-exetim.ads<a-exetim-default.ads \
s-linux.ads<s-linux.ads \
s-osinte.adb<s-osinte-posix.adb
EH_MECHANISM=-gcc
endif
- THREADSLIB = -lpthread
+ THREADSLIB = -lpthread -lrt
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
- EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
+ EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
endif
TOOLS_TARGET_PAIRS = \
ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS_COMMON = \
+ a-exetim.adb<a-exetim-posix.adb \
+ a-exetim.ads<a-exetim-default.ads \
a-intnam.ads<a-intnam-linux.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-gnu.adb
- EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
+ EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
EH_MECHANISM=-gcc
- THREADSLIB = -lpthread
+ THREADSLIB = -lpthread -lrt
GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib
LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
+ a-exetim.adb<a-exetim-posix.adb \
+ a-exetim.ads<a-exetim-default.ads \
a-intnam.ads<a-intnam-linux.ads \
a-numaux.ads<a-numaux-libc-x86.ads \
s-inmaop.adb<s-inmaop-posix.adb \
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
indepsw.adb<indepsw-gnu.adb
- EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
+ EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
EH_MECHANISM=-gcc
MISCLIB=
- THREADSLIB=-lpthread
+ THREADSLIB=-lpthread -lrt
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib
LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
+ a-exetim.adb<a-exetim-posix.adb \
+ a-exetim.ads<a-exetim-default.ads \
a-intnam.ads<a-intnam-linux.ads \
a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \
indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
- EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
+ EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
EH_MECHANISM=-gcc
- THREADSLIB=-lpthread
+ THREADSLIB=-lpthread -lrt
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib
LIBRARY_VERSION := $(LIB_VERSION)
@end smallexample
@noindent
-This pragma can only appear immediately following a compilation
-unit. The effect is to apply @code{Suppress (All_Checks)} to the unit
-which it follows. This pragma is implemented for compatibility with DEC
-Ada 83 usage. The use of pragma @code{Suppress (All_Checks)} as a normal
-configuration pragma is the preferred usage in GNAT@.
+This pragma can appear anywhere within a unit.
+The effect is to apply @code{Suppress (All_Checks)} to the unit
+in which it appears. This pragma is implemented for compatibility with DEC
+Ada 83 usage where it appears at the end of a unit, and for compatibility
+with Rational Ada, where it appears as a program unit pragma.
+The use of the standard Ada pragma @code{Suppress (All_Checks)}
+as a normal configuration pragma is the preferred usage in GNAT@.
@node Pragma Suppress_Exception_Locations
@unnumberedsec Pragma Suppress_Exception_Locations
-- g C/C++ macro C/C++ fun-like macro
-- h Interface (Ada 2005) Abstract type
-- i signed integer object signed integer type
- -- j (unused) (unused)
+ -- j C++ class object C++ class
-- k generic package package
-- l label on loop label on statement
-- m modular integer object modular integer type
end if;
end Style_Checks;
+ -------------------------
+ -- Suppress_All (GNAT) --
+ -------------------------
+
+ -- pragma Suppress_All
+
+ -- This is a rather odd pragma, because other compilers allow it in
+ -- strange places. DEC allows it at the end of units, and Rational
+ -- allows it as a program unit pragma, when it would be more natural
+ -- if it were a configuration pragma.
+
+ -- Since the reason we provide this pragma is for compatibility with
+ -- these other compilers, we want to accomodate these strange placement
+ -- rules, and the easiest thing is simply to allow it anywhere in a
+ -- unit. If this pragma appears anywhere within a unit, then the effect
+ -- is as though a pragma Suppress (All_Checks) had appeared as the first
+ -- line of the current file, i.e. as the first configuration pragma in
+ -- the current unit.
+
+ -- To get this effect, we set the flag Has_Pragma_Suppress_All in the
+ -- compilation unit node for the current source file then in the last
+ -- stage of parsing a file, if this flag is set, we materialize the
+ -- Suppress (All_Checks) pragma, marked as not coming from Source.
+
+ when Pragma_Suppress_All =>
+ Set_Has_Pragma_Suppress_All (Cunit (Current_Source_Unit));
+
---------------------
-- Warnings (GNAT) --
---------------------
Pragma_Stream_Convert |
Pragma_Subtitle |
Pragma_Suppress |
- Pragma_Suppress_All |
Pragma_Suppress_Debug_Info |
Pragma_Suppress_Exception_Locations |
Pragma_Suppress_Initialization |
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
+with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
with Sinfo; use Sinfo;
-- posted as required, and a value of No_Uint is returned.
function Is_Operational_Item (N : Node_Id) return Boolean;
- -- A specification for a stream attribute is allowed before the full
- -- type is declared, as explained in AI-00137 and the corrigendum.
- -- Attributes that do not specify a representation characteristic are
- -- operational attributes.
+ -- A specification for a stream attribute is allowed before the full type
+ -- is declared, as explained in AI-00137 and the corrigendum. Attributes
+ -- that do not specify a representation characteristic are operational
+ -- attributes.
procedure New_Stream_Subprogram
(N : Node_Id;
Loc : constant Source_Ptr := Sloc (Aspect);
Id : constant Node_Id := Identifier (Aspect);
Expr : constant Node_Id := Expression (Aspect);
+ Eloc : Source_Ptr := Sloc (Expr);
Nam : constant Name_Id := Chars (Id);
A_Id : constant Aspect_Id := Get_Aspect_Id (Nam);
Anod : Node_Id;
Set_Entity (Aspect, E);
Ent := New_Occurrence_Of (E, Sloc (Id));
- -- Check for duplicate aspect
+ -- Check for duplicate aspect. Note that the Comes_From_Source
+ -- test allows duplicate Pre/Post's that we generate internally
+ -- to escape being flagged here.
Anod := First (L);
while Anod /= Aspect loop
- if Nam = Chars (Identifier (Anod)) then
+ if Nam = Chars (Identifier (Anod))
+ and then Comes_From_Source (Aspect)
+ then
Error_Msg_Name_1 := Nam;
Error_Msg_Sloc := Sloc (Anod);
Error_Msg_NE
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
- New_Occurrence_Of (E, Sloc (Expr)),
+ New_Occurrence_Of (E, Eloc),
Relocate_Node (Expr)),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
Relocate_Node (Expr),
- New_Occurrence_Of (E, Sloc (Expr))),
+ New_Occurrence_Of (E, Eloc)),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)),
Class_Present => Class_Present (Aspect));
Delay_Required := False;
- -- Aspect Pre corresponds to pragma Precondition with single
- -- argument that is the expression (we never give a message
- -- argument). This is inserted right after the declaration,
- -- to get the required pragma placement.
-
- when Aspect_Pre =>
+ -- Aspects Pre/Post generate Precondition/Postcondition pragmas
+ -- with a first argument that is the expression, and a second
+ -- argument that is an informative message if the test fails.
+ -- This is inserted right after the declaration, to get the
+ -- required pragma placement.
- -- Construct the pragma
+ when Aspect_Pre | Aspect_Post => declare
+ Pname : Name_Id;
+ Msg : Node_Id;
- Aitem :=
- Make_Pragma (Loc,
- Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Precondition),
- Class_Present => Class_Present (Aspect),
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Expr),
- Chars => Name_Check,
- Expression => Relocate_Node (Expr))));
-
- -- We don't have to play the delay game here. The required
- -- delay in this case is already implemented by the pragma.
+ begin
+ if A_Id = Aspect_Pre then
+ Pname := Name_Precondition;
+ else
+ Pname := Name_Postcondition;
+ end if;
- Delay_Required := False;
+ -- If the expressions is of the form A and then B, then
+ -- we generate separate Pre/Post aspects for the separate
+ -- clauses. Since we allow multiple pragmas, there is no
+ -- problem in allowing multiple Pre/Post aspects internally.
+
+ while Nkind (Expr) = N_And_Then loop
+ Insert_After (Aspect,
+ Make_Aspect_Specification (Sloc (Right_Opnd (Expr)),
+ Identifier => Identifier (Aspect),
+ Expression => Relocate_Node (Right_Opnd (Expr)),
+ Class_Present => Class_Present (Aspect)));
+ Rewrite (Expr, Relocate_Node (Left_Opnd (Expr)));
+ Eloc := Sloc (Expr);
+ end loop;
- -- Aspect Post corresponds to pragma Postcondition with single
- -- argument that is the expression (we never give a message
- -- argument. This is inserted right after the declaration,
- -- to get the required pragma placement.
+ -- Proceed with handling what's left after this split up
- when Aspect_Post =>
+ Msg :=
+ Make_String_Literal (Eloc,
+ Strval => "failed "
+ & Get_Name_String (Pname)
+ & " from line "
+ & Get_Logical_Line_Number_Img (Eloc));
-- Construct the pragma
Aitem :=
- Make_Pragma (Sloc (Aspect),
+ Make_Pragma (Loc,
Pragma_Identifier =>
- Make_Identifier (Sloc (Id), Name_Postcondition),
+ Make_Identifier (Sloc (Id),
+ Chars => Pname),
Class_Present => Class_Present (Aspect),
Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (Expr),
+ Make_Pragma_Argument_Association (Eloc,
Chars => Name_Check,
- Expression => Relocate_Node (Expr))));
+ Expression => Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Eloc,
+ Chars => Name_Message,
+ Expression => Msg)));
- -- We don't have to play the delay game here. The required
- -- delay in this case is already implemented by the pragma.
+ Set_From_Aspect_Specification (Aitem, True);
- Delay_Required := False;
+ -- For Pre/Post cases, insert immediately after the entity
+ -- declaration, since that is the required pragma placement.
+ -- Note that for these aspects, we do not have to worry
+ -- about delay issues, since the pragmas themselves deal
+ -- with delay of visibility for the expression analysis.
+
+ Insert_After (N, Aitem);
+ goto Continue;
+ end;
-- Aspects currently unimplemented
Pragma_Misplaced;
return;
- elsif Has_Priority_Pragma (P) then
+ elsif Has_Pragma_Priority (P) then
Error_Pragma ("duplicate pragma% not allowed");
else
- Set_Has_Priority_Pragma (P, True);
+ Set_Has_Pragma_Priority (P, True);
Record_Rep_Item (Defining_Identifier (Parent (P)), N);
end if;
end Interrupt_Priority;
Pragma_Misplaced;
end if;
- if Has_Priority_Pragma (P) then
+ if Has_Pragma_Priority (P) then
Error_Pragma ("duplicate pragma% not allowed");
else
- Set_Has_Priority_Pragma (P, True);
+ Set_Has_Pragma_Priority (P, True);
if Nkind_In (P, N_Protected_Definition, N_Task_Definition) then
Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-- pragma Suppress_All;
- -- The only check made here is that the pragma appears in the proper
- -- place, i.e. following a compilation unit. If indeed it appears in
- -- this context, then the parser has already inserted an equivalent
- -- pragma Suppress (All_Checks) to get the required effect.
+ -- The only check made here is that the pragma has no arguments.
+ -- There are no placement rules, and the processing required (setting
+ -- the Has_Pragma_Suppress_All flag in the compilation unit node was
+ -- taken care of by the parser). Process_Compilation_Unit_Pragmas
+ -- then creates and inserts a pragma Suppress (All_Checks).
when Pragma_Suppress_All =>
GNAT_Pragma;
Check_Arg_Count (0);
- if Nkind (Parent (N)) /= N_Compilation_Unit_Aux
- or else not Is_List_Member (N)
- or else List_Containing (N) /= Pragmas_After (Parent (N))
- then
- if not CodePeer_Mode then
- Error_Pragma
- ("misplaced pragma%, must follow compilation unit");
- end if;
- end if;
-
-------------------------
-- Suppress_Debug_Info --
-------------------------
procedure Process_Compilation_Unit_Pragmas (N : Node_Id) is
begin
-- A special check for pragma Suppress_All, a very strange DEC pragma,
- -- strange because it comes at the end of the unit. If we have a pragma
- -- Suppress_All in the Pragmas_After of the current unit, then we insert
- -- a pragma Suppress (All_Checks) at the start of the context clause to
- -- ensure the correct processing.
-
- declare
- PA : constant List_Id := Pragmas_After (Aux_Decls_Node (N));
- P : Node_Id;
+ -- strange because it comes at the end of the unit. Rational has the
+ -- same name for a pragma, but treats it as a program unit pragma, In
+ -- GNAT we just decide to allow it anywhere at all. If it appeared then
+ -- the flag Has_Pragma_Suppress_All was set on the compilation unit
+ -- node, and we insert a pragma Suppress (All_Checks) at the start of
+ -- the context clause to ensure the correct processing.
+
+ if Has_Pragma_Suppress_All (N) then
+ Prepend_To (Context_Items (N),
+ Make_Pragma (Sloc (N),
+ Chars => Name_Suppress,
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Sloc (N),
+ Expression =>
+ Make_Identifier (Sloc (N),
+ Chars => Name_All_Checks)))));
+ end if;
- begin
- if Present (PA) then
- P := First (PA);
- while Present (P) loop
- if Pragma_Name (P) = Name_Suppress_All then
- Prepend_To (Context_Items (N),
- Make_Pragma (Sloc (P),
- Chars => Name_Suppress,
- Pragma_Argument_Associations => New_List (
- Make_Pragma_Argument_Association (Sloc (P),
- Expression =>
- Make_Identifier (Sloc (P),
- Chars => Name_All_Checks)))));
- exit;
- end if;
+ -- Nothing else to do at the current time!
- Next (P);
- end loop;
- end if;
- end;
end Process_Compilation_Unit_Pragmas;
--------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with any
-- special issues regarding pragmas. In particular, we have to deal with
- -- Suppress_All at this stage, since it appears after the unit instead of
- -- before.
+ -- Suppress_All at this stage, since it can appear after the unit instead
+ -- of before (actually we allow it to appear anywhere).
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
-- This routine is used to set an encoded interface name. The node S is an
return Flag17 (N);
end Has_No_Elaboration_Code;
- function Has_Priority_Pragma
+ function Has_Pragma_Priority
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Subprogram_Body
or else NT (N).Nkind = N_Task_Definition);
return Flag6 (N);
- end Has_Priority_Pragma;
+ end Has_Pragma_Priority;
+
+ function Has_Pragma_Suppress_All
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Compilation_Unit);
+ return Flag14 (N);
+ end Has_Pragma_Suppress_All;
function Has_Private_View
(N : Node_Id) return Boolean is
Set_Flag17 (N, Val);
end Set_Has_No_Elaboration_Code;
- procedure Set_Has_Priority_Pragma
+ procedure Set_Has_Pragma_Priority
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Subprogram_Body
or else NT (N).Nkind = N_Task_Definition);
Set_Flag6 (N, Val);
- end Set_Has_Priority_Pragma;
+ end Set_Has_Pragma_Priority;
+
+ procedure Set_Has_Pragma_Suppress_All
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Compilation_Unit);
+ Set_Flag14 (N, Val);
+ end Set_Has_Pragma_Suppress_All;
procedure Set_Has_Private_View
(N : Node_Id; Val : Boolean := True) is
-- generate elaboration code, and non-preelaborated packages which do
-- not generate elaboration code.
- -- Has_Priority_Pragma (Flag6-Sem)
+ -- Has_Pragma_Suppress_All (Flag14-Sem)
+ -- This flag is set in an N_Compilation_Unit node if the Suppress_All
+ -- pragma appears anywhere in the unit. This accomodates the rather
+ -- strange placement rules of other compilers (DEC permits it at the
+ -- end of a unit, and Rational allows it as a program unit pragma). We
+ -- allow it anywhere at all, and consider it equivalent to a pragma
+ -- Suppress (All_Checks) appearing at the start of the configuration
+ -- pragmas for the unit.
+
+ -- Has_Pragma_Priority (Flag6-Sem)
-- A flag present in N_Subprogram_Body, N_Task_Definition and
-- N_Protected_Definition nodes to flag the presence of either a Priority
-- or Interrupt_Priority pragma in the declaration sequence (public or
-- Acts_As_Spec (Flag4-Sem)
-- Bad_Is_Detected (Flag15) used only by parser
-- Do_Storage_Check (Flag17-Sem)
- -- Has_Priority_Pragma (Flag6-Sem)
+ -- Has_Pragma_Priority (Flag6-Sem)
-- Is_Protected_Subprogram_Body (Flag7-Sem)
-- Is_Entry_Barrier_Function (Flag8-Sem)
-- Is_Task_Master (Flag5-Sem)
-- Visible_Declarations (List2)
-- Private_Declarations (List3) (set to No_List if no private part)
-- End_Label (Node4)
- -- Has_Priority_Pragma (Flag6-Sem)
+ -- Has_Pragma_Priority (Flag6-Sem)
-- Has_Storage_Size_Pragma (Flag5-Sem)
-- Has_Task_Info_Pragma (Flag7-Sem)
-- Has_Task_Name_Pragma (Flag8-Sem)
-- Visible_Declarations (List2)
-- Private_Declarations (List3) (set to No_List if no private part)
-- End_Label (Node4)
- -- Has_Priority_Pragma (Flag6-Sem)
+ -- Has_Pragma_Priority (Flag6-Sem)
------------------------------------------
-- 9.4 Protected Operation Declaration --
-- Acts_As_Spec (Flag4-Sem) flag for subprogram body with no spec
-- Context_Pending (Flag16-Sem)
-- First_Inlined_Subprogram (Node3-Sem)
+ -- Has_Pragma_Suppress_All (Flag14-Sem)
-- N_Compilation_Unit_Aux
-- Sloc is a copy of the Sloc from the N_Compilation_Unit node
function Has_No_Elaboration_Code
(N : Node_Id) return Boolean; -- Flag17
- function Has_Priority_Pragma
+ function Has_Pragma_Priority
(N : Node_Id) return Boolean; -- Flag6
+ function Has_Pragma_Suppress_All
+ (N : Node_Id) return Boolean; -- Flag14
+
function Has_Private_View
(N : Node_Id) return Boolean; -- Flag11
procedure Set_Has_No_Elaboration_Code
(N : Node_Id; Val : Boolean := True); -- Flag17
- procedure Set_Has_Priority_Pragma
+ procedure Set_Has_Pragma_Priority
(N : Node_Id; Val : Boolean := True); -- Flag6
+ procedure Set_Has_Pragma_Suppress_All
+ (N : Node_Id; Val : Boolean := True); -- Flag14
+
procedure Set_Has_Private_View
(N : Node_Id; Val : Boolean := True); -- Flag11
pragma Inline (Has_Local_Raise);
pragma Inline (Has_Self_Reference);
pragma Inline (Has_No_Elaboration_Code);
- pragma Inline (Has_Priority_Pragma);
+ pragma Inline (Has_Pragma_Priority);
+ pragma Inline (Has_Pragma_Suppress_All);
pragma Inline (Has_Private_View);
pragma Inline (Has_Relative_Deadline_Pragma);
pragma Inline (Has_Storage_Size_Pragma);
pragma Inline (Set_Has_Local_Raise);
pragma Inline (Set_Has_Dynamic_Range_Check);
pragma Inline (Set_Has_No_Elaboration_Code);
- pragma Inline (Set_Has_Priority_Pragma);
+ pragma Inline (Set_Has_Pragma_Priority);
+ pragma Inline (Set_Has_Pragma_Suppress_All);
pragma Inline (Set_Has_Private_View);
pragma Inline (Set_Has_Relative_Deadline_Pragma);
pragma Inline (Set_Has_Storage_Size_Pragma);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
Get_Name_String_And_Append
(Reference_Name (Get_Source_File_Index (Ptr)));
Add_Char_To_Name_Buffer (':');
- Add_Nat_To_Name_Buffer
- (Nat (Get_Logical_Line_Number (Ptr)));
+ Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (Ptr)));
Ptr := Instantiation_Location (Ptr);
exit when Ptr = No_Location;
end if;
end Get_Logical_Line_Number;
+ ---------------------------------
+ -- Get_Logical_Line_Number_Img --
+ ---------------------------------
+
+ function Get_Logical_Line_Number_Img
+ (P : Source_Ptr) return String
+ is
+ begin
+ Name_Len := 0;
+ Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (P)));
+ return Name_Buffer (1 .. Name_Len);
+ end Get_Logical_Line_Number_Img;
+
------------------------------
-- Get_Physical_Line_Number --
------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- reference pragmas have been encountered, the value returned is
-- the same as the physical line number.
+ function Get_Logical_Line_Number_Img
+ (P : Source_Ptr) return String;
+ -- Same as above function, but returns the line number as a string of
+ -- decimal digits, with no leading space. Destroys Name_Buffer.
+
function Get_Physical_Line_Number
(P : Source_Ptr) return Physical_Line_Number;
-- The line number of the specified source position is obtained by
projects / gcc.git / commitdiff