diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 36 | ||||
| -rw-r--r-- | gcc/ada/a-exetim-default.ads | 98 | ||||
| -rw-r--r-- | gcc/ada/a-exetim-posix.adb | 157 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 81 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 24 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 12 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 107 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 34 | ||||
| -rw-r--r-- | gcc/ada/sinput.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 7 |
16 files changed, 550 insertions, 162 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5daf93f..f267703 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,41 @@ 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 * sem_ch13.adb (Analyze_Aspect_Specifications): Fix bad Sloc on aspects * sem_prag.adb (Fix_Error): Only change pragma names for pragmas from diff --git a/gcc/ada/a-exetim-default.ads b/gcc/ada/a-exetim-default.ads new file mode 100644 index 0000000..edc6f19 --- /dev/null +++ b/gcc/ada/a-exetim-default.ads @@ -0,0 +1,98 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/a-exetim-posix.adb b/gcc/ada/a-exetim-posix.adb new file mode 100644 index 0000000..fe00abe --- /dev/null +++ b/gcc/ada/a-exetim-posix.adb @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index aa03557..dd392ec 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -10428,7 +10428,7 @@ package body Exp_Ch9 is -- 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); @@ -12057,7 +12057,7 @@ package body Exp_Ch9 is -- 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 := @@ -12357,7 +12357,7 @@ package body Exp_Ch9 is -- 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), diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 5fd4e94..6bbeb4a 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1618,19 +1618,19 @@ ada/errout.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ 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 \ @@ -2642,19 +2642,19 @@ ada/inline.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 @@ -2978,8 +2978,8 @@ ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \ @@ -4377,8 +4377,8 @@ ada/tbuild.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \ @@ -4391,16 +4391,17 @@ ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index fed952a..b824096 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1074,6 +1074,8 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) 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 @@ -1099,9 +1101,9 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) 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 = \ @@ -1785,6 +1787,8 @@ endif 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 \ @@ -1836,9 +1840,9 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),) 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) @@ -1983,6 +1987,8 @@ endif 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 \ @@ -2004,10 +2010,10 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),) 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) @@ -2072,6 +2078,8 @@ endif 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 \ @@ -2095,9 +2103,9 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),) 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) diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 0e61132..919de82 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -4815,11 +4815,13 @@ pragma Suppress_All; @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 diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index d14e163..9fb8b2d 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -549,7 +549,7 @@ package Lib.Xref is -- 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 diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index be94746..109326c 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -982,6 +982,33 @@ begin 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) -- --------------------- @@ -1204,7 +1231,6 @@ begin Pragma_Stream_Convert | Pragma_Subtitle | Pragma_Suppress | - Pragma_Suppress_All | Pragma_Suppress_Debug_Info | Pragma_Suppress_Exception_Locations | Pragma_Suppress_Initialization | diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9d15092..4660361 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -50,6 +50,7 @@ with Sem_Res; use Sem_Res; 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; @@ -81,10 +82,10 @@ package body Sem_Ch13 is -- 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; @@ -666,6 +667,7 @@ package body Sem_Ch13 is 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; @@ -675,11 +677,15 @@ package body Sem_Ch13 is 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 @@ -826,7 +832,7 @@ package body Sem_Ch13 is 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))); @@ -848,7 +854,7 @@ package body Sem_Ch13 is 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)); @@ -858,53 +864,74 @@ package body Sem_Ch13 is 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index da5c601..91a6e8f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8970,11 +8970,11 @@ package body Sem_Prag is 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; @@ -10994,10 +10994,10 @@ package body Sem_Prag is 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); @@ -12196,25 +12196,16 @@ package body Sem_Prag is -- 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 -- ------------------------- @@ -13782,35 +13773,26 @@ package body Sem_Prag is 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; -------- diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index b5e843a..4106120 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -99,8 +99,8 @@ package Sem_Prag is 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 diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index ead2fcb..66199c2 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1453,7 +1453,7 @@ package body Sinfo is 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 @@ -1461,7 +1461,15 @@ package body Sinfo is 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 @@ -4406,7 +4414,7 @@ package body Sinfo 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 @@ -4414,7 +4422,15 @@ package body Sinfo is 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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index a7f4370..6009160 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1133,7 +1133,16 @@ package Sinfo 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 @@ -4462,7 +4471,7 @@ package Sinfo is -- 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) @@ -4946,7 +4955,7 @@ package Sinfo is -- 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) @@ -5033,7 +5042,7 @@ package Sinfo is -- 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 -- @@ -5547,6 +5556,7 @@ package Sinfo is -- 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 @@ -8291,9 +8301,12 @@ package Sinfo is 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 @@ -9233,9 +9246,12 @@ package Sinfo is 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 @@ -11593,7 +11609,8 @@ package Sinfo is 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); @@ -11903,7 +11920,8 @@ package Sinfo is 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); diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 10f188c..650efa9 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -227,8 +227,7 @@ package body Sinput is 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; @@ -299,6 +298,19 @@ package body Sinput is 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 -- ------------------------------ diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 4f23516..a6a9767 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -487,6 +487,11 @@ package Sinput is -- 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 |