From af4b94345e257e98a61127d9ea9624ff4dabc714 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 21 Apr 2004 12:10:33 +0200 Subject: [multiple changes] 2004-04-21 Pascal Obry * adaint.c (__gnat_portable_spawn): Quote first argument (argv[0]) passed to spawnvp() to properly handle program pathname with spaces on Win32. 2004-04-21 Emmanuel Briot * g-debpoo.adb (Print_Info): Avoid extra work if Display_Slots is False. (Allocate, Deallocate, Free_Physically): Make sure the tasks are unlocked in case of exceptions. 2004-04-21 Joel Brobecker * gigi.h (get_target_no_dollar_in_label): Remove extern declaration. This function does not exist anymore. 2004-04-21 Thomas Quinot * gnatbind.adb, gnatlink.adb: Update name of imported C symbol. * link.c: Move variables to the __gnat name space. * Makefile.in: list link.o explicitly when needed. * mlib.adb: Remove pragma Linker_Option for "link.o" from mlib. 2004-04-21 Javier Miranda * einfo.adb (Original_Access_Type): New subprogram (Set_Original_Access_Type): New subprogram (Write_Field21_Name): Write the name of the new field * einfo.ads (Original_Access_Type): New field present in access to subprogram types. Addition of two new entities: E_Anonymous_Access_Subprogram_Type, and E_Anonymous_Access_Protected_Subprogram_Type. * lib-xref.adb (Output_One_Ref): Give support to anonymous access to subprogram types. * lib-xref.ads (Xref_Entity_Letters): Initialize values corresponding to anonymous access to subprogram types. * sem_attr.adb (Resolve_Attribute): Give support to anonymous access to subprogram types. * sem_ch3.adb (Access_Definition): Complete decoration of entities corresponding to anonymous access to subprogram types. (Analyze_Component_Declaration): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Array_Type_Declaration): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Process_Discriminants): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Replace_Anonymous_Access_To_Protected_Subprogram): New formal. * sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New formal. * sem_ch6.adb, sem_type.adb, sem_res.adb: Give support to anonymous access to subprogram types. * sem_util.adb (Has_Declarations): Addition of package_specification nodes. 2004-04-21 Ed Schonberg * sem_prag.adb (Make_Inline): If subprogram is a renaming, propagate inlined flags to renamed entity only if in current unit. 2004-04-21 Thomas Quinot * s-parint.ads: Add DSA implementation marker. * rtsfind.ads, rtsfind.adb, snames.ads, snames.adb, s-rpc.adb: Use the value of System.Partition_Interface.DSA_Implementation to determine what version of the distributed systems annex is available (no implementation, GLADE, or PolyORB). 2004-04-21 Joel Brobecker * targtyps.c (get_target_no_dollar_in_label): Remove, no longer used. 2004-04-21 Richard Kenner * utils.c (convert, case CONSTRUCTOR, COMPONENT_REF): Do not make node with new type if alias sets differ. Fixes ACATS c41103b. 2004-04-21 Vincent Celier * prj.ads: Remove FORTRAN as an accepted language: not tested yet. Add array Lang_Args for the language specific compiling argument switches. * gnat_ugn.texi: Explain in more details when a library is rebuilt. 2004-04-21 Sergey Rybin * gnat_rm.texi: Update the descripton of the Eliminate pragma according to the recent changes in the format of the parameters of the pragma (replacing Homonym_Number with Source_Location). From-SVN: r80956 --- gcc/ada/ChangeLog | 104 +++++ gcc/ada/Makefile.in | 15 +- gcc/ada/adaint.c | 14 +- gcc/ada/einfo.adb | 21 +- gcc/ada/einfo.ads | 34 +- gcc/ada/g-debpoo.adb | 127 +++--- gcc/ada/gigi.h | 3 +- gcc/ada/gnat_rm.texi | 88 +++- gcc/ada/gnat_ugn.texi | 31 +- gcc/ada/gnatbind.adb | 3 +- gcc/ada/gnatlink.adb | 14 +- gcc/ada/lib-xref.adb | 25 +- gcc/ada/lib-xref.ads | 4 +- gcc/ada/link.c | 175 ++++---- gcc/ada/mlib.adb | 5 +- gcc/ada/prj.ads | 26 +- gcc/ada/rtsfind.adb | 63 +-- gcc/ada/rtsfind.ads | 2 + gcc/ada/s-parint.ads | 3 + gcc/ada/s-rpc.adb | 9 +- gcc/ada/sem_attr.adb | 26 +- gcc/ada/sem_ch3.adb | 49 ++- gcc/ada/sem_ch3.ads | 7 +- gcc/ada/sem_ch6.adb | 55 ++- gcc/ada/sem_prag.adb | 17 +- gcc/ada/sem_res.adb | 4 +- gcc/ada/sem_type.adb | 21 + gcc/ada/sem_util.adb | 3 +- gcc/ada/snames.adb | 3 + gcc/ada/snames.ads | 1142 +++++++++++++++++++++++++------------------------ gcc/ada/targtyps.c | 12 +- gcc/ada/utils.c | 11 +- 32 files changed, 1228 insertions(+), 888 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a3e8394..55b06a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,107 @@ +2004-04-21 Pascal Obry + + * adaint.c (__gnat_portable_spawn): Quote first argument (argv[0]) + passed to spawnvp() to properly handle program pathname with spaces on + Win32. + +2004-04-21 Emmanuel Briot + + * g-debpoo.adb (Print_Info): Avoid extra work if Display_Slots is False. + (Allocate, Deallocate, Free_Physically): Make sure the tasks are + unlocked in case of exceptions. + +2004-04-21 Joel Brobecker + + * gigi.h (get_target_no_dollar_in_label): Remove extern declaration. + This function does not exist anymore. + +2004-04-21 Thomas Quinot + + * gnatbind.adb, gnatlink.adb: Update name of imported C symbol. + + * link.c: Move variables to the __gnat name space. + + * Makefile.in: list link.o explicitly when needed. + + * mlib.adb: Remove pragma Linker_Option for "link.o" from mlib. + +2004-04-21 Javier Miranda + + * einfo.adb (Original_Access_Type): New subprogram + (Set_Original_Access_Type): New subprogram + (Write_Field21_Name): Write the name of the new field + + * einfo.ads (Original_Access_Type): New field present in access to + subprogram types. + Addition of two new entities: E_Anonymous_Access_Subprogram_Type, and + E_Anonymous_Access_Protected_Subprogram_Type. + + * lib-xref.adb (Output_One_Ref): Give support to anonymous access to + subprogram types. + + * lib-xref.ads (Xref_Entity_Letters): Initialize values corresponding + to anonymous access to subprogram types. + + * sem_attr.adb (Resolve_Attribute): Give support to anonymous access + to subprogram types. + + * sem_ch3.adb (Access_Definition): Complete decoration of entities + corresponding to anonymous access to subprogram types. + (Analyze_Component_Declaration): Add new actual to the call to + subprogram replace_anonymous_access_to_protected_subprogram. + (Array_Type_Declaration): Add new actual to the call to subprogram + replace_anonymous_access_to_protected_subprogram. + (Process_Discriminants): Add new actual to the call to subprogram + replace_anonymous_access_to_protected_subprogram. + (Replace_Anonymous_Access_To_Protected_Subprogram): New formal. + + * sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New + formal. + + * sem_ch6.adb, sem_type.adb, sem_res.adb: Give support to anonymous + access to subprogram types. + + * sem_util.adb (Has_Declarations): Addition of package_specification + nodes. + +2004-04-21 Ed Schonberg + + * sem_prag.adb (Make_Inline): If subprogram is a renaming, propagate + inlined flags to renamed entity only if in current unit. + +2004-04-21 Thomas Quinot + + * s-parint.ads: Add DSA implementation marker. + + * rtsfind.ads, rtsfind.adb, snames.ads, snames.adb, s-rpc.adb: Use the + value of System.Partition_Interface.DSA_Implementation to determine + what version of the distributed systems annex is available (no + implementation, GLADE, or PolyORB). + +2004-04-21 Joel Brobecker + + * targtyps.c (get_target_no_dollar_in_label): Remove, no longer used. + +2004-04-21 Richard Kenner + + * utils.c (convert, case CONSTRUCTOR, COMPONENT_REF): Do not make node + with new type if alias sets differ. + Fixes ACATS c41103b. + +2004-04-21 Vincent Celier + + * prj.ads: Remove FORTRAN as an accepted language: not tested yet. + Add array Lang_Args for the language specific compiling argument + switches. + + * gnat_ugn.texi: Explain in more details when a library is rebuilt. + +2004-04-21 Sergey Rybin + + * gnat_rm.texi: Update the descripton of the Eliminate pragma + according to the recent changes in the format of the parameters of the + pragma (replacing Homonym_Number with Source_Location). + 2004-04-19 Arnaud Charlet * 5isystem.ads: Removed, unused. diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index ad17a50..bafeae6 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -251,7 +251,7 @@ LIBIBERTY = ../../libiberty/libiberty.a # and the system's installed libraries. LIBS = $(LIBINTL) $(LIBIBERTY) $(SYSLIBS) LIBDEPS = $(LIBINTL_DEP) $(LIBIBERTY) -TOOLS_LIBS = $(LIBGNAT) $(EXTRA_GNATTOOLS_OBJS) ../../../libiberty/libiberty.a $(SYSLIBS) +TOOLS_LIBS = $(LIBGNAT) $(EXTRA_GNATTOOLS_OBJS) link.o ../../../libiberty/libiberty.a $(SYSLIBS) # Specify the directories to be searched for header files. # Both . and srcdir are used, in that order, @@ -299,7 +299,7 @@ Makefile: ../config.status $(srcdir)/Makefile.in $(srcdir)/../version.c # Lists of files for various purposes. -GNATLINK_OBJS = gnatlink.o link.o \ +GNATLINK_OBJS = gnatlink.o \ a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o gnatvsn.o \ hostparm.o interfac.o i-c.o i-cstrin.o namet.o opt.o osint.o output.o rident.o \ s-exctab.o s-secsta.o s-stalib.o s-stoele.o sdefault.o stylesw.o switch.o system.o \ @@ -308,7 +308,7 @@ GNATLINK_OBJS = gnatlink.o link.o \ GNATMAKE_OBJS = a-except.o ctrl_c.o ali.o ali-util.o s-casuti.o \ alloc.o atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o\ erroutc.o errutil.o err_vars.o fmap.o fname.o fname-uf.o fname-sf.o \ - gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o link.o \ + gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o \ make.o makeusg.o makeutl.o mlib.o mlib-fil.o mlib-prj.o mlib-tgt.o mlib-utl.o \ namet.o nlists.o opt.o osint.o osint-m.o output.o \ prj.o prj-attr.o prj-com.o prj-dect.o prj-env.o prj-err.o prj-ext.o prj-nmsc.o \ @@ -583,7 +583,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) a-intnam.ads<4zintnam.ads \ s-osinte.ads<5zosinte.ads \ s-parame.ads<5zparame.ads \ - s-taspri.ads<5ztaspri.ads \ s-vxwork.ads<5pvxwork.ads \ a-taside.adb<1ataside.adb \ @@ -1660,7 +1659,7 @@ endif $(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line $(GNATLINK) -v vxaddr2line -o $@ --GCC="$(CC) $(ADA_INCLUDES)" $(CLIB) -gnatmake-re: ../stamp-tools +gnatmake-re: ../stamp-tools link.o $(GNATMAKE) $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)" $(GNATMAKE) -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)" $(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatmake @@ -1673,7 +1672,7 @@ gnatlink-re: ../stamp-tools link.o $(GNATMAKE) -c $(ADA_INCLUDES) gnatlink --GCC="$(CC) $(ALL_ADAFLAGS)" $(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlink $(GNATLINK) -v gnatlink -o ../../gnatlinknew$(exeext) \ - --GCC="$(CC) $(ADA_INCLUDES)" link.o $(TOOLS_LIBS) + --GCC="$(CC) $(ADA_INCLUDES)" $(TOOLS_LIBS) $(MV) ../../gnatlinknew$(exeext) ../../gnatlink$(exeext) # Needs to be built with CC=gcc @@ -1681,11 +1680,11 @@ gnatlink-re: ../stamp-tools link.o # stamp target in the parent directory whenever gnat1 is rebuilt # Likewise for the tools -../../gnatmake$(exeext): $(P) b_gnatm.o $(GNATMAKE_OBJS) +../../gnatmake$(exeext): $(P) b_gnatm.o link.o $(GNATMAKE_OBJS) $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatm.o $(GNATMAKE_OBJS) \ $(TOOLS_LIBS) -../../gnatlink$(exeext): $(P) b_gnatl.o $(GNATLINK_OBJS) +../../gnatlink$(exeext): $(P) b_gnatl.o link.o $(GNATLINK_OBJS) $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatl.o $(GNATLINK_OBJS) \ $(TOOLS_LIBS) diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 58d955a..d5262af 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -1543,7 +1543,19 @@ __gnat_portable_spawn (char *args[]) int pid ATTRIBUTE_UNUSED; #if defined (MSDOS) || defined (_WIN32) - status = spawnvp (P_WAIT, args[0],(const char* const*)args); + /* args[0] must be quotes as it could contain a full pathname with spaces */ + const char *args_0 = args[0]; + args[0] = (char *)xmalloc (strlen (args_0) + 3); + strcpy (args[0], "\""); + strcat (args[0], args_0); + strcat (args[0], "\""); + + status = spawnvp (P_WAIT, args_0, (const char* const*)args); + + /* restore previous value */ + free (args[0]); + args[0] = args_0; + if (status < 0) return -1; else diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 543aa2c..b2ad23f 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -1845,6 +1845,14 @@ package body Einfo is return Node17 (Id); end Object_Ref; + function Original_Access_Type (Id : E) return E is + begin + pragma Assert + (Ekind (Id) = E_Access_Subprogram_Type + or else Ekind (Id) = E_Access_Protected_Subprogram_Type); + return Node21 (Id); + end Original_Access_Type; + function Original_Array_Type (Id : E) return E is begin pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id)); @@ -3747,7 +3755,6 @@ package body Einfo is Set_Flag136 (Id, V); end Set_No_Strict_Aliasing; - procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is begin pragma Assert (Ekind (Id) = E_Modular_Integer_Type); @@ -3796,6 +3803,14 @@ package body Einfo is Set_Node17 (Id, V); end Set_Object_Ref; + procedure Set_Original_Access_Type (Id : E; V : E) is + begin + pragma Assert + (Ekind (Id) = E_Access_Subprogram_Type + or else Ekind (Id) = E_Access_Protected_Subprogram_Type); + Set_Node21 (Id, V); + end Set_Original_Access_Type; + procedure Set_Original_Array_Type (Id : E; V : E) is begin pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id)); @@ -6996,6 +7011,10 @@ package body Einfo is Modular_Integer_Kind => Write_Str ("Original_Array_Type"); + when E_Access_Subprogram_Type | + E_Access_Protected_Subprogram_Type => + Write_Str ("Original_Access_Type"); + when others => Write_Str ("Field21??"); end case; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a8180e4..9548da4 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2633,6 +2633,12 @@ package Einfo is -- Applies to subprograms and subprogram types. Yields the number of -- formals as a value of type Pos. +-- Original_Access_Type (Node21) +-- Present in access to subprogram types. Anonymous access to protected +-- subprogram types are replaced by an occurrence of an internal access +-- to subprogram type. This field links the replacement entity with the +-- original entity. + -- Original_Array_Type (Node21) -- Present in modular types and array types and subtypes. Set only -- if the Is_Packed_Array_Type flag is set, indicating that the type @@ -3113,7 +3119,11 @@ package Einfo is -- The following three entity kinds are introduced by the corresponding -- type definitions: - -- E_Access_Type, E_General_Access_Type, E_Anonymous_Access_Type. + -- E_Access_Type, + -- E_General_Access_Type, + -- E_Anonymous_Access_Subprogram_Type, + -- E_Anonymous_Access_Protected_Subprogram_Type + -- E_Anonymous_Access_Type. -- In addition, we define the kind E_Allocator_Type to label -- allocators. This is because special resolution rules apply to this @@ -3321,6 +3331,14 @@ package Einfo is -- and a protected operation within, and have different compile-time -- and run-time properties than other access to subprograms. + E_Anonymous_Access_Subprogram_Type, + -- An anonymous access to subprogram type, created by an access to + -- subprogram declaration. + + E_Anonymous_Access_Protected_Subprogram_Type, + -- An anonymous access to protected subprogram type, created by an + -- access to subprogram declaration. + E_Anonymous_Access_Type, -- An anonymous access type created by an access parameter or access -- discriminant. @@ -3542,6 +3560,8 @@ package Einfo is -- E_General_Access_Type -- E_Access_Subprogram_Type -- E_Access_Protected_Subprogram_Type + -- E_Anonymous_Access_Subprogram_Type + -- E_Anonymous_Access_Protected_Subprogram_Type E_Anonymous_Access_Type; subtype Array_Kind is Entity_Kind range @@ -3637,6 +3657,8 @@ package Einfo is -- E_General_Access_Type -- E_Access_Subprogram_Type -- E_Access_Protected_Subprogram_Type + -- E_Anonymous_Access_Subprogram_Type + -- E_Anonymous_Access_Protected_Subprogram_Type E_Anonymous_Access_Type; subtype Enumeration_Kind is Entity_Kind range @@ -3809,6 +3831,8 @@ package Einfo is -- E_General_Access_Type -- E_Access_Subprogram_Type, -- E_Access_Protected_Subprogram_Type + -- E_Anonymous_Access_Subprogram_Type + -- E_Anonymous_Access_Protected_Subprogram_Type -- E_Anonymous_Access_Type -- E_Array_Type -- E_Array_Subtype @@ -3994,12 +4018,14 @@ package Einfo is -- E_Access_Protected_Subprogram_Type -- Equivalent_Type (Node18) -- Directly_Designated_Type (Node20) + -- Original_Access_Type (Node21) -- Needs_No_Actuals (Flag22) -- (plus type attributes) -- E_Access_Subprogram_Type -- Equivalent_Type (Node18) (remote types only) -- Directly_Designated_Type (Node20) + -- Original_Access_Type (Node21) -- Needs_No_Actuals (Flag22) -- (plus type attributes) @@ -4025,6 +4051,8 @@ package Einfo is -- Directly_Designated_Type (Node20) -- (plus type attributes) + -- E_Anonymous_Access_Subprogram_Type + -- E_Anonymous_Access_Protected_Subprogram_Type -- E_Anonymous_Access_Type -- Storage_Size_Variable (Node15) ??? is this needed ??? -- Directly_Designated_Type (Node20) @@ -5180,6 +5208,7 @@ package Einfo is function Normalized_Position (Id : E) return U; function Normalized_Position_Max (Id : E) return U; function Object_Ref (Id : E) return E; + function Original_Access_Type (Id : E) return E; function Original_Array_Type (Id : E) return E; function Original_Record_Component (Id : E) return E; function Packed_Array_Type (Id : E) return E; @@ -5653,6 +5682,7 @@ package Einfo is procedure Set_Normalized_Position (Id : E; V : U); procedure Set_Normalized_Position_Max (Id : E; V : U); procedure Set_Object_Ref (Id : E; V : E); + procedure Set_Original_Access_Type (Id : E; V : E); procedure Set_Original_Array_Type (Id : E; V : E); procedure Set_Original_Record_Component (Id : E; V : E); procedure Set_Packed_Array_Type (Id : E; V : E); @@ -6180,6 +6210,7 @@ package Einfo is pragma Inline (Normalized_Position); pragma Inline (Normalized_Position_Max); pragma Inline (Object_Ref); + pragma Inline (Original_Access_Type); pragma Inline (Original_Array_Type); pragma Inline (Original_Record_Component); pragma Inline (Packed_Array_Type); @@ -6486,6 +6517,7 @@ package Einfo is pragma Inline (Set_Normalized_Position); pragma Inline (Set_Normalized_Position_Max); pragma Inline (Set_Object_Ref); + pragma Inline (Set_Original_Access_Type); pragma Inline (Set_Original_Array_Type); pragma Inline (Set_Original_Record_Component); pragma Inline (Set_Packed_Array_Type); diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb index 4eeae1a..4d93310 100644 --- a/gcc/ada/g-debpoo.adb +++ b/gcc/ada/g-debpoo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -769,6 +769,11 @@ package body GNAT.Debug_Pools is end if; Unlock_Task.all; + + exception + when others => + Unlock_Task.all; + raise; end Allocate; ------------------ @@ -1056,6 +1061,11 @@ package body GNAT.Debug_Pools is end if; Unlock_Task.all; + + exception + when others => + Unlock_Task.all; + raise; end Free_Physically; ---------------- @@ -1166,6 +1176,11 @@ package body GNAT.Debug_Pools is Unlock_Task.all; end if; + + exception + when others => + Unlock_Task.all; + raise; end Deallocate; -------------------- @@ -1310,71 +1325,71 @@ package body GNAT.Debug_Pools is Put_Line (""); - Data := Backtrace_Htable.Get_First; - while Data /= null loop - if Data.Kind in Alloc .. Dealloc then - Elem := - new Traceback_Htable_Elem' - (Traceback => new Tracebacks_Array'(Data.Traceback.all), - Count => Data.Count, - Kind => Data.Kind, - Total => Data.Total, - Next => null); - Backtrace_Htable_Cumulate.Set (Elem); - - if Cumulate then - if Data.Kind = Alloc then - K := Indirect_Alloc; - else - K := Indirect_Dealloc; - end if; + if Display_Slots then + Data := Backtrace_Htable.Get_First; + while Data /= null loop + if Data.Kind in Alloc .. Dealloc then + Elem := + new Traceback_Htable_Elem' + (Traceback => new Tracebacks_Array'(Data.Traceback.all), + Count => Data.Count, + Kind => Data.Kind, + Total => Data.Total, + Next => null); + Backtrace_Htable_Cumulate.Set (Elem); + + if Cumulate then + if Data.Kind = Alloc then + K := Indirect_Alloc; + else + K := Indirect_Dealloc; + end if; - -- Propagate the direct call to all its parents + -- Propagate the direct call to all its parents - for T in Data.Traceback'First + 1 .. Data.Traceback'Last loop - Elem := Backtrace_Htable_Cumulate.Get - (Data.Traceback - (T .. Data.Traceback'Last)'Unrestricted_Access); + for T in Data.Traceback'First + 1 .. Data.Traceback'Last loop + Elem := Backtrace_Htable_Cumulate.Get + (Data.Traceback + (T .. Data.Traceback'Last)'Unrestricted_Access); - -- If not, insert it + -- If not, insert it - if Elem = null then - Elem := new Traceback_Htable_Elem' - (Traceback => new Tracebacks_Array' - (Data.Traceback (T .. Data.Traceback'Last)), - Count => Data.Count, - Kind => K, - Total => Data.Total, - Next => null); - Backtrace_Htable_Cumulate.Set (Elem); + if Elem = null then + Elem := new Traceback_Htable_Elem' + (Traceback => new Tracebacks_Array' + (Data.Traceback (T .. Data.Traceback'Last)), + Count => Data.Count, + Kind => K, + Total => Data.Total, + Next => null); + Backtrace_Htable_Cumulate.Set (Elem); - -- Properly take into account that the subprograms - -- indirectly called might be doing either allocations - -- or deallocations. This needs to be reflected in the - -- counts. + -- Properly take into account that the subprograms + -- indirectly called might be doing either allocations + -- or deallocations. This needs to be reflected in the + -- counts. - else - Elem.Count := Elem.Count + Data.Count; + else + Elem.Count := Elem.Count + Data.Count; - if K = Elem.Kind then - Elem.Total := Elem.Total + Data.Total; + if K = Elem.Kind then + Elem.Total := Elem.Total + Data.Total; - elsif Elem.Total > Data.Total then - Elem.Total := Elem.Total - Data.Total; + elsif Elem.Total > Data.Total then + Elem.Total := Elem.Total - Data.Total; - else - Elem.Kind := K; - Elem.Total := Data.Total - Elem.Total; + else + Elem.Kind := K; + Elem.Total := Data.Total - Elem.Total; + end if; end if; - end if; - end loop; - end if; + end loop; + end if; - Data := Backtrace_Htable.Get_Next; - end if; - end loop; + Data := Backtrace_Htable.Get_Next; + end if; + end loop; - if Display_Slots then Put_Line ("List of allocations/deallocations: "); Data := Backtrace_Htable_Cumulate.Get_First; @@ -1397,6 +1412,8 @@ package body GNAT.Debug_Pools is Data := Backtrace_Htable_Cumulate.Get_Next; end loop; + + Backtrace_Htable_Cumulate.Reset; end if; if Display_Leaks then @@ -1421,8 +1438,6 @@ package body GNAT.Debug_Pools is Current := Header.Next; end loop; end if; - - Backtrace_Htable_Cumulate.Reset; end Print_Info; ------------------ diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index 423b898..5f5b995 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2003 Free Software Foundation, Inc. * + * Copyright (C) 1992-2004 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- * @@ -756,7 +756,6 @@ extern Pos get_target_double_size (void); extern Pos get_target_long_double_size (void); extern Pos get_target_pointer_size (void); extern Pos get_target_maximum_alignment (void); -extern Boolean get_target_no_dollar_in_label (void); extern Nat get_float_words_be (void); extern Nat get_words_be (void); extern Nat get_bytes_be (void); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 0c64029..3ebbcdf 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -1341,18 +1341,32 @@ pragma Eliminate ( [Entity =>] IDENTIFIER | SELECTED_COMPONENT | STRING_LITERAL - [,[Parameter_Types =>] PARAMETER_TYPES] - [,[Result_Type =>] result_SUBTYPE_NAME] - [,[Homonym_Number =>] INTEGER_LITERAL]); + [,OVERLOADING_RESOLUTION]); + +OVERLOADING_RESOLUTION ::= PARAMETER_AND_RESULT_TYPE_PROFILE | + SOURCE_LOCATION + +PARAMETER_AND_RESULT_TYPE_PROFILE ::= PROCEDURE_PROFILE | + FUNCTION_PROFILE + +PROCEDURE_PROFILE ::= Parameter_Types => PARAMETER_TYPES + +FUNCTION_PROFILE ::= [Parameter_Types => PARAMETER_TYPES,] + Result_Type => result_SUBTYPE_NAME] PARAMETER_TYPES ::= (SUBTYPE_NAME @{, SUBTYPE_NAME@}) SUBTYPE_NAME ::= STRING_LITERAL + +SOURCE_LOCATION ::= Source_Location => SOURCE_TRACE +SOURCE_TRACE ::= STRING_LITERAL @end smallexample @noindent + This pragma indicates that the given entity is not used outside the -compilation unit it is defined in. The entity may be either a subprogram -or a variable. +compilation unit it is defined in. The entity an explicitly declared +subprogram, including subprogram declared by subprogram instantiations and +subprograms declared in package instantiations. If the entity to be eliminated is a library level subprogram, then the first form of pragma @code{Eliminate} is used with only a single argument. @@ -1366,29 +1380,55 @@ the particular entity. If the second argument is in string form, it must correspond to the internal manner in which GNAT stores entity names (see compilation unit Namet in the compiler sources for details). -The remaining parameters are optionally used to distinguish -between overloaded subprograms. There are two ways of doing this. +The remaining parameters (OVERLOADING_RESOLUTION) are optionally used +to distinguish between overloaded subprograms. If a pragma does not contain +the OVERLOADING_RESOLUTION parameter(s), it is applied to all the overloaded +subprograms denoted by the first two parameters. + +Use PARAMETER_AND_RESULT_TYPE_PROFILE to specify the profile of the subprogram +to be eliminated in a manner similar to that used for the extended +@code{Import} and @code{Export} pragmas, except that the subtype names are +always given as string literals. At the moment, this form of distinguishing +overloaded subprograms is implemented only partially, so we do not recommend +using it for practical subprogram elimination. + +Note, that in case of a parameterless procedure its profile is represented +as @code{Parameter_Types => ("")} + +Alternatively, the @code{Source_Location} parameter is used to specify +which overloaded alternative is to be eliminated by pointing to the +location of the DEFINING_PROGRAM_UNIT_NAME of this subprogram in the +source text. The string literal submitted as SOURCE_TRACE should have +the following format: -Use @code{Parameter_Types} and @code{Result_Type} to specify the -profile of the subprogram to be eliminated in a manner similar to that -used for -the extended @code{Import} and @code{Export} pragmas, except that the -subtype names are always given as string literals, again corresponding -to the internal manner in which GNAT stores entity names. +@smallexample @c ada +SOURCE_TRACE ::= SOURCE_LOCATION@{LBRACKET SOURCE_LOCATION RBRACKET@} + +LBRACKET ::= [ +RBRACKET ::= ] + +SOURCE_LOCATION ::= FILE_NAME:LINE_NUMBER +FILE_NAME ::= STRING_LITERAL +LINE_NUMBER ::= DIGIT @{DIGIT@} +@end smallexample + +SOURCE_TRACE should be the short name of the source file (with no directory +information), and LINE_NUMBER is supposed to point to the line where the +defining name of the subprogram is located. -Alternatively, the @code{Homonym_Number} parameter is used to specify -which overloaded alternative is to be eliminated. A value of 1 indicates -the first subprogram (in lexical order), 2 indicates the second etc. +For the subprograms that are not a part of generic instantiations, only one +SOURCE_LOCATION is used. If a subprogram is declared in a package +instantiation, SOURCE_TRACE contains two SOURCE_LOCATIONs, the first one is +the location of the (DEFINING_PROGRAM_UNIT_NAME of the) instantiation, and the +second one denotes the declaration of the corresponding subprogram in the +generic package. This approach is recursively used to create SOURCE_LOCATIONs +in case of nested instantiations. The effect of the pragma is to allow the compiler to eliminate the code or data associated with the named entity. Any reference to an eliminated entity outside the compilation unit it is defined in, causes a compile time or link time error. -The parameters of this pragma may be given in any order, as long as -the usual rules for use of named parameters and position parameters -are used. - The intention of pragma @code{Eliminate} is to allow a program to be compiled in a system independent manner, with unused entities eliminated, without the requirement of modifying the source text. Normally the required set @@ -1400,6 +1440,10 @@ Note that the reason this pragma takes string literals where names might be expected is that a pragma @code{Eliminate} can appear in a context where the relevant names are not visible. +Note that any change in the source files that includes removing, splitting of +adding lines may make the set of Eliminate pragmas using SOURCE_LOCATION +parameter illegal. + @node Pragma Export_Exception @unnumberedsec Pragma Export_Exception @cindex OpenVMS @@ -12568,7 +12612,6 @@ primarily intended to be constructed automatically using a binding generator tool, although it is possible to construct them by hand. No suitable binding generator tool is supplied with GNAT though. - Using these pragmas it is possible to achieve complete inter-operability between Ada tagged types and C class definitions. See @ref{Implementation Defined Pragmas}, for more details. @@ -12692,7 +12735,7 @@ including machine instructions in a subprogram. The two features are similar, and both are closely related to the mechanism provided by the asm instruction in the GNU C compiler. Full understanding and use of the facilities in this package requires understanding the asm -instruction as described in @cite{Using the GNU Compiler Collection (GCC)} +instruction as described in @cite{Using the GNU Compiler Collection (GCC)} by Richard Stallman. The relevant section is titled ``Extensions to the C Language Family'' -> ``Assembler Instructions with C Expression Operands''. @@ -14099,3 +14142,4 @@ environment in which the gnat tool will execute. @contents @bye + diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 795b2ec..b009ec6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -12441,12 +12441,37 @@ When @command{gnatmake} detects that a project file is a library project file, it will check all immediate sources of the project and rebuild the library if any of the sources have been recompiled. -When a library is built or rebuilt, an attempt is made to delete all +Standard project files can import library project files. In such cases, +the libraries will only be rebuild if some of its sources are recompiled +because they are in the closure of some other source in an importing project. +Sources of the library project files that are not in such a closure will +not be checked, unless the full library is checked, because one of its sources +needs to be recompiled. + +For instance, assume the project file @code{A} imports the library project file +@code{L}. The immediate sources of A are @file{a1.adb}, @file{a2.ads} and +@file{a2.adb}. The immediate sources of L are @file{l1.ads}, @file{l1.adb}, +@file{l2.ads}, @file{l2.adb}. + +If @file{l1.adb} has been modified, then the library associated with @code{L} +will be rebuild when compiling all the immediate sources of @code{A} only +if @file{a1.ads}, @file{a2.ads} or @file{a2.adb} includes a statement +@code{"with L1;"}. + +To be sure that all the sources in the library associated with @code{L} are +up to date, and that all the sources of parject @code{A} are also up to date, +the following two commands needs to be used: + +@smallexample +gnatmake -Pl.gpr +gnatmake -Pa.gpr +@end smallexample + +When a library is built or rebuilt, an attempt is made first to delete all files in the library directory. All @file{ALI} files will also be copied from the object directory to the library directory. To build executables, @command{gnatmake} will use the -library rather than the individual object files. The copy of the @file{ALI} -files are made read-only. +library rather than the individual object files. @c ********************************************** diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index cb5c695..755a34e 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -364,7 +364,8 @@ begin declare Shared_Libgnat_Default : Character; - pragma Import (C, Shared_Libgnat_Default, "shared_libgnat_default"); + pragma Import + (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default"); SHARED : constant Character := 'H'; STATIC : constant Character := 'T'; diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 0b9bd2a..41ef0a2 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -158,7 +158,8 @@ procedure Gnatlink is -- Set to False if bind file is not to be compiled Object_List_File_Supported : Boolean; - pragma Import (C, Object_List_File_Supported, "objlist_file_supported"); + pragma Import + (C, Object_List_File_Supported, "__gnat_objlist_file_supported"); -- Predicate indicating whether the linker has an option whereby the -- names of object files can be passed to the linker in a file. @@ -587,7 +588,7 @@ procedure Gnatlink is -- Projected number of bytes for the linker command line Link_Max : Integer; - pragma Import (C, Link_Max, "link_max"); + pragma Import (C, Link_Max, "__gnat_link_max"); -- Maximum number of bytes on the command line supported by the OS -- linker. Passed this limit the response file mechanism must be used -- if supported. @@ -649,23 +650,24 @@ procedure Gnatlink is RB_Nfirst : Integer; -- Slice first index Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Run_Path_Option_Ptr, "run_path_option"); + pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); -- Pointer to string representing the native linker option which -- specifies the path where the dynamic loader should find shared -- libraries. Equal to null string if this system doesn't support it. Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Object_Library_Ext_Ptr, "object_library_extension"); + pragma Import + (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension"); -- Pointer to string specifying the default extension for -- object libraries, e.g. Unix uses ".a", VMS uses ".olb". Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Object_File_Option_Ptr, "object_file_option"); + pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option"); -- Pointer to a string representing the linker option which specifies -- the response file. Using_GNU_Linker : Boolean; - pragma Import (C, Using_GNU_Linker, "using_gnu_linker"); + pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker"); -- Predicate indicating whether this target uses the GNU linker. In -- this case we must output a GNU linker compatible response file. diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 200ad6a..107c849 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1147,16 +1147,25 @@ package body Lib.Xref is -- Special handling for access parameter - if Ekind (Etype (XE.Ent)) = E_Anonymous_Access_Type - and then Is_Formal (XE.Ent) - then - Ctyp := 'p'; + declare + K : constant Entity_Kind := Ekind (Etype (XE.Ent)); + + begin + if (K = E_Anonymous_Access_Type + or else + K = E_Anonymous_Access_Subprogram_Type + or else K = + E_Anonymous_Access_Protected_Subprogram_Type) + and then Is_Formal (XE.Ent) + then + Ctyp := 'p'; - -- Special handling for Boolean + -- Special handling for Boolean - elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then - Ctyp := 'b'; - end if; + elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then + Ctyp := 'b'; + end if; + end; end if; -- Special handling for abstract types and operations. diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 34434b9..59c703f 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004, 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- -- @@ -395,6 +395,8 @@ package Lib.Xref is E_Access_Subprogram_Type => 'P', E_Access_Protected_Subprogram_Type => 'P', + E_Anonymous_Access_Subprogram_Type => ' ', + E_Anonymous_Access_Protected_Subprogram_Type => ' ', E_Anonymous_Access_Type => ' ', E_Array_Type => 'A', E_Array_Subtype => 'A', diff --git a/gcc/ada/link.c b/gcc/ada/link.c index a7ae922..bf98e90 100644 --- a/gcc/ada/link.c +++ b/gcc/ada/link.c @@ -30,10 +30,9 @@ * * ****************************************************************************/ -/* This file contains parameterizations used by gnatlink.adb in handling */ -/* very long linker lines in systems where there are limitations on the */ -/* argument length when the command line is used to pass items to the */ -/* linker */ +/* This file contains host-specific parameters describing the behaviour */ +/* of the linker. It is used by gnatlink as well as all tools that use */ +/* Mlib. */ #include @@ -83,113 +82,113 @@ #define STATIC 'T' #if defined (__osf__) -const char *object_file_option = "-Wl,-input,"; -const char *run_path_option = "-Wl,-rpath,"; -int link_max = 10000; -unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = "-Wl,-input,"; +const char *__gnat_run_path_option = "-Wl,-rpath,"; +int __gnat_link_max = 10000; +unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #elif defined (sgi) -const char *object_file_option = "-Wl,-objectlist,"; -const char *run_path_option = "-Wl,-rpath,"; -int link_max = 5000; -unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = "-Wl,-objectlist,"; +const char *__gnat_run_path_option = "-Wl,-rpath,"; +int __gnat_link_max = 5000; +unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #elif defined (__WIN32) -const char *object_file_option = ""; -const char *run_path_option = ""; -int link_max = 30000; -unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 1; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = ""; +int __gnat_link_max = 30000; +unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 1; +const char *__gnat_object_library_extension = ".a"; #elif defined (__INTERIX) -const char *object_file_option = ""; -const char *run_path_option = ""; -int link_max = 5000; -unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 1; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = ""; +int __gnat_link_max = 5000; +unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 1; +const char *__gnat_object_library_extension = ".a"; #elif defined (hpux) -const char *object_file_option = "-Wl,-c,"; -const char *run_path_option = "-Wl,+b,"; -int link_max = 5000; -unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = "-Wl,-c,"; +const char *__gnat_run_path_option = "-Wl,+b,"; +int __gnat_link_max = 5000; +unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #elif defined (_AIX) -const char *object_file_option = "-Wl,-f,"; -const char *run_path_option = ""; -int link_max = 15000; -const unsigned char objlist_file_supported = 1; -char shared_libgnat_default = STATIC; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = "-Wl,-f,"; +const char *__gnat_run_path_option = ""; +int __gnat_link_max = 15000; +const unsigned char __gnat_objlist_file_supported = 1; +char __gnat_shared_libgnat_default = STATIC; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #elif defined (VMS) -const char *object_file_option = ""; -const char *run_path_option = ""; -char shared_libgnat_default = STATIC; -int link_max = 2147483647; -unsigned char objlist_file_supported = 0; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".olb"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = ""; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 2147483647; +unsigned char __gnat_objlist_file_supported = 0; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".olb"; #elif defined (sun) -const char *object_file_option = ""; -const char *run_path_option = "-Wl,-R,"; -char shared_libgnat_default = STATIC; -int link_max = 2147483647; -unsigned char objlist_file_supported = 0; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = "-Wl,-R"; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 2147483647; +unsigned char __gnat_objlist_file_supported = 0; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #elif defined (__FreeBSD__) -char *object_file_option = ""; -char *run_path_option = "-Wl,-rpath,"; -char shared_libgnat_default = STATIC; -int link_max = 2147483647; -unsigned char objlist_file_supported = 0; -unsigned char using_gnu_linker = 0; -char *object_library_extension = ".a"; +char *__gnat_object_file_option = ""; +char *__gnat_run_path_option = "-Wl,-rpath,"; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 2147483647; +unsigned char __gnat_objlist_file_supported = 0; +unsigned char __gnat_using_gnu_linker = 0; +char *__gnat_object_library_extension = ".a"; #elif defined (linux) -const char *object_file_option = ""; -const char *run_path_option = "-Wl,-rpath,"; -char shared_libgnat_default = STATIC; -int link_max = 8192; -unsigned char objlist_file_supported = 1; -unsigned char using_gnu_linker = 1; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = "-Wl,-rpath,"; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 8192; +unsigned char __gnat_objlist_file_supported = 1; +unsigned char __gnat_using_gnu_linker = 1; +const char *__gnat_object_library_extension = ".a"; #elif defined (__svr4__) && defined (i386) -const char *object_file_option = ""; -const char *run_path_option = ""; -char shared_libgnat_default = STATIC; -int link_max = 2147483647; -unsigned char objlist_file_supported = 0; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_object_file_option = ""; +const char *__gnat_run_path_option = ""; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 2147483647; +unsigned char __gnat_objlist_file_supported = 0; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #else /* These are the default settings for all other systems. No response file is supported, the shared library default is STATIC. */ -const char *run_path_option = ""; -const char *object_file_option = ""; -char shared_libgnat_default = STATIC; -int link_max = 2147483647; -unsigned char objlist_file_supported = 0; -unsigned char using_gnu_linker = 0; -const char *object_library_extension = ".a"; +const char *__gnat_run_path_option = ""; +const char *__gnat_object_file_option = ""; +char __gnat_shared_libgnat_default = STATIC; +int __gnat_link_max = 2147483647; +unsigned char __gnat_objlist_file_supported = 0; +unsigned char __gnat_using_gnu_linker = 0; +const char *__gnat_object_library_extension = ".a"; #endif diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 3cefb6d..8e6d0e3 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -41,9 +41,6 @@ with System; package body MLib is - pragma Linker_Options ("link.o"); - -- For run_path_option string. - ------------------- -- Build_Library -- ------------------- @@ -296,7 +293,7 @@ package body MLib is function Linker_Library_Path_Option return String_Access is Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Run_Path_Option_Ptr, "run_path_option"); + pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); -- Pointer to string representing the native linker option which -- specifies the path where the dynamic loader should find shared -- libraries. Equal to null string if this system doesn't support it. diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index b9965bc..ebbc859 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -71,7 +71,7 @@ package Prj is -- To specify how to process project files type Programming_Language is - (Lang_Ada, Lang_C, Lang_C_Plus_Plus, Lang_Fortran); + (Lang_Ada, Lang_C, Lang_C_Plus_Plus); -- The list of language supported subtype Other_Programming_Language is @@ -85,12 +85,10 @@ package Prj is Lang_Ada_Name : aliased String := "ada"; Lang_C_Name : aliased String := "c"; Lang_C_Plus_Plus_Name : aliased String := "c++"; - Lang_Fortran_Name : aliased String := "for"; Lang_Names : constant array (Programming_Language) of String_Access := (Lang_Ada => Lang_Ada_Name 'Access, Lang_C => Lang_C_Name 'Access, - Lang_C_Plus_Plus => Lang_C_Plus_Plus_Name'Access, - Lang_Fortran => Lang_Fortran_Name'Access); + Lang_C_Plus_Plus => Lang_C_Plus_Plus_Name'Access); -- Names of the supported programming languages, to be used after switch -- -x when using a GCC compiler. @@ -100,25 +98,21 @@ package Prj is Lang_Ada_Display_Name : aliased String := "Ada"; Lang_C_Display_Name : aliased String := "C"; Lang_C_Plus_Plus_Display_Name : aliased String := "C++"; - Lang_Fortran_Display_Name : aliased String := "Fortran"; Lang_Display_Names : constant array (Programming_Language) of String_Access := (Lang_Ada => Lang_Ada_Display_Name 'Access, Lang_C => Lang_C_Display_Name 'Access, - Lang_C_Plus_Plus => Lang_C_Plus_Plus_Display_Name'Access, - Lang_Fortran => Lang_Fortran_Display_Name'Access); + Lang_C_Plus_Plus => Lang_C_Plus_Plus_Display_Name'Access); -- Names of the supported programming languages, to be used for display -- purposes. Ada_Impl_Suffix : aliased String := ".adb"; C_Impl_Suffix : aliased String := ".c"; C_Plus_Plus_Impl_Suffix : aliased String := ".cc"; - Fortran_Impl_Suffix : aliased String := ".for"; Lang_Suffixes : constant array (Programming_Language) of String_Access := (Lang_Ada => Ada_Impl_Suffix 'Access, Lang_C => C_Impl_Suffix 'Access, - Lang_C_Plus_Plus => C_Plus_Plus_Impl_Suffix'Access, - Lang_Fortran => Fortran_Impl_Suffix'Access); + Lang_C_Plus_Plus => C_Plus_Plus_Impl_Suffix'Access); -- Default extension of the sources of the different languages. Lang_Suffix_Ids : array (Programming_Language) of Name_Id; @@ -127,17 +121,23 @@ package Prj is Gnatmake_String : aliased String := "gnatmake"; Gcc_String : aliased String := "gcc"; G_Plus_Plus_String : aliased String := "g++"; - G77_String : aliased String := "g77"; Default_Compiler_Names : constant array (Programming_Language) of String_Access := (Lang_Ada => Gnatmake_String 'Access, Lang_C => Gcc_String 'Access, - Lang_C_Plus_Plus => G_Plus_Plus_String'Access, - Lang_Fortran => G77_String 'Access); + Lang_C_Plus_Plus => G_Plus_Plus_String'Access); -- Default names of the compilers for the supported languages. -- Used when no IDE'Compiler_Command is specified for a language. -- For Ada, specify the gnatmake executable. + Ada_Args_Strings : aliased String := ""; + C_Args_String : aliased String := "c"; + C_Plus_Plus_Args_String : aliased String := "xx"; + Lang_Args : constant array (Programming_Language) of String_Access := + (Lang_Ada => Ada_Args_Strings 'Access, + Lang_C => C_Args_String 'Access, + Lang_C_Plus_Plus => C_Plus_Plus_Args_String'Access); + type Other_Source_Id is new Nat; No_Other_Source : constant Other_Source_Id := 0; type Other_Source is record diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index c0249de..f677fab 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -786,9 +786,6 @@ package body Rtsfind is --------------- procedure Check_RPC is - Body_Name : Unit_Name_Type; - Unum : Unit_Number_Type; - begin -- Bypass this check if debug flag -gnatdR set @@ -799,47 +796,33 @@ package body Rtsfind is -- Otherwise we need the check if we are going after one of -- the critical entities in System.RPC in stubs mode. + -- ??? Should we do this for other s-parint/s-polint entities + -- too? + if (Distribution_Stub_Mode = Generate_Receiver_Stub_Body or else Distribution_Stub_Mode = Generate_Caller_Stub_Body) and then (E = RE_Do_Rpc - or else E = RE_Do_Apc - or else E = RE_Params_Stream_Type - or else E = RE_RPC_Receiver) + or else + E = RE_Do_Apc + or else + E = RE_Params_Stream_Type + or else + E = RE_RPC_Receiver) then - -- Load body of System.Rpc, and abort if this is the body that is - -- provided by GNAT, for which these features are not supported - -- on current target. We identify the gnat body by the presence - -- of a local entity called Gnat in the first declaration. - - Lib_Unit := Unit (Cunit (U.Unum)); - Body_Name := Get_Body_Name (Get_Unit_Name (Lib_Unit)); - Unum := - Load_Unit - (Load_Name => Body_Name, - Required => False, - Subunit => False, - Error_Node => Empty, - Renamings => True); - - if Unum /= No_Unit then - declare - Decls : constant List_Id := - Declarations (Unit (Cunit (Unum))); - - begin - if Present (Decls) - and then Nkind (First (Decls)) = N_Object_Declaration - and then - Chars (Defining_Identifier (First (Decls))) = Name_Gnat - then - Set_Standard_Error; - Write_Str ("distribution feature not supported"); - Write_Eol; - raise Unrecoverable_Error; - end if; - end; - end if; + declare + DSA_Implementation : constant Entity_Id := + RTE (RE_DSA_Implementation); + begin + if Chars (Entity (Expression + (Parent (DSA_Implementation)))) = Name_No_DSA + then + Set_Standard_Error; + Write_Str ("distribution feature not supported"); + Write_Eol; + raise Unrecoverable_Error; + end if; + end; end if; end Check_RPC; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index aa51054..b0eafd6 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -997,6 +997,7 @@ package Rtsfind is RE_Size_Type, -- System.Parameters RE_Unspecified_Size, -- System.Parameters + RE_DSA_Implementation, -- System.Partition_Interface RE_Get_Active_Partition_Id, -- System.Partition_Interface RE_Get_Passive_Partition_Id, -- System.Partition_Interface RE_Get_Local_Partition_Id, -- System.Partition_Interface @@ -2066,6 +2067,7 @@ package Rtsfind is RE_Size_Type => System_Parameters, RE_Unspecified_Size => System_Parameters, + RE_DSA_Implementation => System_Partition_Interface, RE_Get_Active_Partition_Id => System_Partition_Interface, RE_Get_Passive_Partition_Id => System_Partition_Interface, RE_Get_Local_Partition_Id => System_Partition_Interface, diff --git a/gcc/ada/s-parint.ads b/gcc/ada/s-parint.ads index 287b2b3..cf0a8b3 100644 --- a/gcc/ada/s-parint.ads +++ b/gcc/ada/s-parint.ads @@ -42,6 +42,9 @@ package System.Partition_Interface is pragma Elaborate_Body; + type DSA_Implementation_Name is (No_DSA, GLADE_DSA, PolyORB_DSA); + DSA_Implementation : constant DSA_Implementation_Name := No_DSA; + type Subprogram_Id is new Natural; -- This type is used exclusively by stubs diff --git a/gcc/ada/s-rpc.adb b/gcc/ada/s-rpc.adb index 33ab366..ba4d0d9 100644 --- a/gcc/ada/s-rpc.adb +++ b/gcc/ada/s-rpc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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,13 +43,6 @@ with Ada.Exceptions; use Ada.Exceptions; package body System.RPC is - GNAT : constant Boolean := True; - pragma Unreferenced (GNAT); - -- This dummy entity allows the compiler to recognize that this is the - -- version of this package that is supplied by GNAT, not by the user. - -- This is used to cause a compile time error if an attempt is made to - -- use features in System.RPC that are only available from a true PCS. - CRLF : constant String := ASCII.CR & ASCII.LF; Msg : constant String := diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 370bc1d..171373ca 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6507,7 +6507,12 @@ package body Sem_Attr is -- also be accessibility checks on those, this is where the -- checks can eventually be centralized ??? - if Ekind (Btyp) = E_Access_Subprogram_Type then + if Ekind (Btyp) = E_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Protected_Subprogram_Type + then if Convention (Btyp) /= Convention (Entity (P)) then Error_Msg_N ("subprogram has invalid convention for context", P); @@ -6533,8 +6538,12 @@ package body Sem_Attr is -- warning is needed. elsif Attr_Id = Attribute_Access - and then Subprogram_Access_Level (Entity (P)) - > Type_Access_Level (Btyp) + and then Subprogram_Access_Level (Entity (P)) > + Type_Access_Level (Btyp) + and then Ekind (Btyp) /= + E_Anonymous_Access_Subprogram_Type + and then Ekind (Btyp) /= + E_Anonymous_Access_Protected_Subprogram_Type then if not In_Instance_Body then Error_Msg_N @@ -6617,9 +6626,12 @@ package body Sem_Attr is -- The rule does not apply to 'Unrestricted_Access. if not (Ekind (Btyp) = E_Access_Subprogram_Type + or else Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type or else (Is_Record_Type (Btyp) and then Present (Corresponding_Remote_Type (Btyp))) or else Ekind (Btyp) = E_Access_Protected_Subprogram_Type + or else Ekind (Btyp) + = E_Anonymous_Access_Protected_Subprogram_Type or else Is_Access_Constant (Btyp) or else Is_Variable (P) or else Attr_Id = Attribute_Unrestricted_Access) @@ -6791,13 +6803,17 @@ package body Sem_Attr is end if; end if; - if Ekind (Btyp) = E_Access_Protected_Subprogram_Type + if (Ekind (Btyp) = E_Access_Protected_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Protected_Subprogram_Type) and then Is_Entity_Name (P) and then not Is_Protected_Type (Scope (Entity (P))) then Error_Msg_N ("context requires a protected subprogram", P); - elsif Ekind (Btyp) = E_Access_Subprogram_Type + elsif (Ekind (Btyp) = E_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type) and then Ekind (Etype (N)) = E_Access_Protected_Subprogram_Type then Error_Msg_N ("context requires a non-protected subprogram", P); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index cf6cfac..8a1105a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -684,6 +684,15 @@ package body Sem_Ch3 is Access_Subprogram_Declaration (T_Name => Anon_Type, T_Def => Access_To_Subprogram_Definition (N)); + + if Ekind (Anon_Type) = E_Access_Protected_Subprogram_Type then + Set_Ekind + (Anon_Type, E_Anonymous_Access_Protected_Subprogram_Type); + else + Set_Ekind + (Anon_Type, E_Anonymous_Access_Subprogram_Type); + end if; + return Anon_Type; end if; @@ -992,7 +1001,7 @@ package body Sem_Ch3 is (Access_Definition (Component_Definition (N)))) then - T := Replace_Anonymous_Access_To_Protected_Subprogram (N); + T := Replace_Anonymous_Access_To_Protected_Subprogram (N, T); end if; else @@ -2986,14 +2995,17 @@ package body Sem_Ch3 is -- Ada 0Y (AI-254) - if Present (Access_To_Subprogram_Definition - (Access_Definition (Component_Def))) - and then Protected_Present (Access_To_Subprogram_Definition - (Access_Definition (Component_Def))) - then - Element_Type := - Replace_Anonymous_Access_To_Protected_Subprogram (Def); - end if; + declare + CD : constant Node_Id := + Access_To_Subprogram_Definition + (Access_Definition (Component_Def)); + begin + if Present (CD) and then Protected_Present (CD) then + Element_Type := + Replace_Anonymous_Access_To_Protected_Subprogram + (Def, Element_Type); + end if; + end; else pragma Assert (False); @@ -3142,7 +3154,8 @@ package body Sem_Ch3 is ------------------------------------------------------ function Replace_Anonymous_Access_To_Protected_Subprogram - (N : Node_Id) return Entity_Id + (N : Node_Id; + Prev_E : Entity_Id) return Entity_Id is Loc : constant Source_Ptr := Sloc (N); @@ -3184,17 +3197,23 @@ package body Sem_Ch3 is Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => Anon, Type_Definition => - Access_To_Subprogram_Definition (Acc)); + Copy_Separate_Tree (Access_To_Subprogram_Definition (Acc))); Mark_Rewrite_Insertion (Decl); -- Insert the new declaration in the nearest enclosing scope - while not Has_Declarations (P) loop + while Present (P) and then not Has_Declarations (P) loop P := Parent (P); end loop; - Prepend (Decl, Declarations (P)); + pragma Assert (Present (P)); + + if Nkind (P) = N_Package_Specification then + Prepend (Decl, Visible_Declarations (P)); + else + Prepend (Decl, Declarations (P)); + end if; -- Replace the anonymous type with an occurrence of the new declaration. -- In all cases the rewriten node does not have the null-exclusion @@ -3221,6 +3240,7 @@ package body Sem_Ch3 is Analyze (Decl); Scope_Stack.Append (Curr_Scope); + Set_Original_Access_Type (Anon, Prev_E); return Anon; end Replace_Anonymous_Access_To_Protected_Subprogram; @@ -11613,7 +11633,8 @@ package body Sem_Ch3 is (Discriminant_Type (Discr))) then Discr_Type := - Replace_Anonymous_Access_To_Protected_Subprogram (Discr); + Replace_Anonymous_Access_To_Protected_Subprogram + (Discr, Discr_Type); end if; else diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index fb233a2..08b2c20 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -207,11 +207,14 @@ package Sem_Ch3 is -- Prev is entity on the partial view, on which references are posted. function Replace_Anonymous_Access_To_Protected_Subprogram - (N : Node_Id) return Entity_Id; + (N : Node_Id; + Prev_E : Entity_Id) return Entity_Id; -- Ada 0Y (AI-254): Create and decorate an internal full type declaration -- in the enclosing scope corresponding to an anonymous access to protected -- subprogram. In addition, replace the anonymous access by an occurrence - -- of this internal type. Return the entity of this type declaration. + -- of this internal type. Prev_Etype is used to link the new internal + -- entity with the anonymous entity. Return the entity of this type + -- declaration. procedure Set_Completion_Referenced (E : Entity_Id); -- If E is the completion of a private or incomplete type declaration, diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4fe8cdb..b06eaa2 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2956,6 +2956,7 @@ package body Sem_Ch6 is is Type_1 : Entity_Id := T1; Type_2 : Entity_Id := T2; + Are_Anonymous_Access_To_Subprogram_Types : Boolean := False; function Base_Types_Match (T1, T2 : Entity_Id) return Boolean; -- If neither T1 nor T2 are generic actual types, or if they are @@ -3030,11 +3031,32 @@ package body Sem_Ch6 is or else Subtypes_Statically_Match (Type_1, Full_View (Type_2)); end if; + -- Ada 0Y (AI-254): Detect anonymous access to subprogram types. In + -- case of anonymous access to protected subprogram types the anonymous + -- type declaration has been replaced by an occurrence of an internal + -- access to subprogram type declaration + + Are_Anonymous_Access_To_Subprogram_Types := + (Ekind (Type_1) = E_Anonymous_Access_Subprogram_Type + and then Ekind (Type_2) = E_Anonymous_Access_Subprogram_Type) + or else + ((Ekind (Type_1) = E_Access_Protected_Subprogram_Type + and then Ekind (Type_2) = E_Access_Protected_Subprogram_Type) + and then (not Comes_From_Source (Type_1) + and not Comes_From_Source (Type_2)) + and then (Present (Original_Access_Type (Type_1)) + and Present (Original_Access_Type (Type_2))) + and then (Ekind (Original_Access_Type (Type_1)) + = E_Anonymous_Access_Protected_Subprogram_Type + and Ekind (Original_Access_Type (Type_2)) + = E_Anonymous_Access_Protected_Subprogram_Type)); + -- Test anonymous access type case. For this case, static subtype -- matching is required for mode conformance (RM 6.3.1(15)) - if Ekind (Type_1) = E_Anonymous_Access_Type - and then Ekind (Type_2) = E_Anonymous_Access_Type + if (Ekind (Type_1) = E_Anonymous_Access_Type + and then Ekind (Type_2) = E_Anonymous_Access_Type) + or else Are_Anonymous_Access_To_Subprogram_Types -- Ada 0Y (AI-254) then declare Desig_1 : Entity_Id; @@ -3083,11 +3105,17 @@ package body Sem_Ch6 is Conforming_Types (Etype (Base_Type (Desig_1)), Etype (Base_Type (Desig_2)), Ctype); + + elsif Are_Anonymous_Access_To_Subprogram_Types then + return Ctype = Type_Conformant + or else + Subtypes_Statically_Match (Desig_1, Desig_2); + else return Base_Type (Desig_1) = Base_Type (Desig_2) and then (Ctype = Type_Conformant - or else - Subtypes_Statically_Match (Desig_1, Desig_2)); + or else + Subtypes_Statically_Match (Desig_1, Desig_2)); end if; end; @@ -4958,14 +4986,17 @@ package body Sem_Ch6 is -- Ada 0Y (AI-254) - if Present (Access_To_Subprogram_Definition - (Parameter_Type (Param_Spec))) - and then Protected_Present (Access_To_Subprogram_Definition - (Parameter_Type (Param_Spec))) - then - Formal_Type := - Replace_Anonymous_Access_To_Protected_Subprogram (Param_Spec); - end if; + declare + AD : constant Node_Id := + Access_To_Subprogram_Definition + (Parameter_Type (Param_Spec)); + begin + if Present (AD) and then Protected_Present (AD) then + Formal_Type := + Replace_Anonymous_Access_To_Protected_Subprogram + (Param_Spec, Formal_Type); + end if; + end; end if; Set_Etype (Formal, Formal_Type); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3b8c2ff..7dcf278 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2949,21 +2949,24 @@ package body Sem_Prag is -- Processing for procedure, operator or function. -- If subprogram is aliased (as for an instance) indicate - -- that the renamed entity is inlined. + -- that the renamed entity (if declared in the same unit) + -- is inlined. if Is_Subprogram (Subp) then while Present (Alias (Inner_Subp)) loop Inner_Subp := Alias (Inner_Subp); end loop; - Set_Inline_Flags (Inner_Subp); + if In_Same_Source_Unit (Subp, Inner_Subp) then + Set_Inline_Flags (Inner_Subp); - Decl := Parent (Parent (Inner_Subp)); + Decl := Parent (Parent (Inner_Subp)); - if Nkind (Decl) = N_Subprogram_Declaration - and then Present (Corresponding_Body (Decl)) - then - Set_Inline_Flags (Corresponding_Body (Decl)); + if Nkind (Decl) = N_Subprogram_Declaration + and then Present (Corresponding_Body (Decl)) + then + Set_Inline_Flags (Corresponding_Body (Decl)); + end if; end if; Applies := True; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 97f9838..9799860 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7076,7 +7076,9 @@ package body Sem_Res is end if; end; - elsif Ekind (Target_Type) = E_Access_Subprogram_Type + elsif (Ekind (Target_Type) = E_Access_Subprogram_Type + or else + Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type) and then Conversion_Check (Ekind (Base_Type (Opnd_Type)) = E_Access_Subprogram_Type, "illegal operand for access subprogram conversion") diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 0ac9686..5da129f 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -731,6 +731,27 @@ package body Sem_Type is then return True; + -- Ada 0Y (AI-254): An Anonymous_Access_To_Subprogram is compatible with + -- itself, or with an anonymous type created for an attribute + -- reference Access. + + elsif (Ekind (Base_Type (T1)) = E_Anonymous_Access_Subprogram_Type + or else + Ekind (Base_Type (T1)) + = E_Anonymous_Access_Protected_Subprogram_Type) + and then Is_Access_Type (T2) + and then (not Comes_From_Source (T1) + or else not Comes_From_Source (T2)) + and then (Is_Overloadable (Designated_Type (T2)) + or else + Ekind (Designated_Type (T2)) = E_Subprogram_Type) + and then + Type_Conformant (Designated_Type (T1), Designated_Type (T2)) + and then + Mode_Conformant (Designated_Type (T1), Designated_Type (T2)) + then + return True; + -- The context can be a remote access type, and the expression the -- corresponding source type declared in a categorized package, or -- viceversa. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ddded5c..edeb398 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2688,7 +2688,8 @@ package body Sem_Util is or else K = N_Package_Body or else K = N_Protected_Body or else K = N_Subprogram_Body - or else K = N_Task_Body; + or else K = N_Task_Body + or else K = N_Package_Specification; end Has_Declarations; -------------------- diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 7eec50a..6de6ee6 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -119,6 +119,9 @@ package body Snames is "system#" & "text_io#" & "wide_text_io#" & + "no_dsa#" & + "glade_dsa#" & + "polyorb_dsa#" & "addr#" & "async#" & "get_active_partition_id#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 562a280..ce6c200 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -233,57 +233,63 @@ package Snames is Name_Text_IO : constant Name_Id := N + 060; Name_Wide_Text_IO : constant Name_Id := N + 061; + -- Names of implementations of the distributed systems annex + + Name_No_DSA : constant Name_Id := N + 062; + Name_GLADE_DSA : constant Name_Id := N + 063; + Name_PolyORB_DSA : constant Name_Id := N + 064; + -- Names of identifiers used in expanding distribution stubs - Name_Addr : constant Name_Id := N + 062; - Name_Async : constant Name_Id := N + 063; - Name_Get_Active_Partition_ID : constant Name_Id := N + 064; - Name_Get_RCI_Package_Receiver : constant Name_Id := N + 065; - Name_Get_RCI_Package_Ref : constant Name_Id := N + 066; - Name_Origin : constant Name_Id := N + 067; - Name_Params : constant Name_Id := N + 068; - Name_Partition : constant Name_Id := N + 069; - Name_Partition_Interface : constant Name_Id := N + 070; - Name_Ras : constant Name_Id := N + 071; - Name_Call : constant Name_Id := N + 072; - Name_RCI_Name : constant Name_Id := N + 073; - Name_Receiver : constant Name_Id := N + 074; - Name_Result : constant Name_Id := N + 075; - Name_Rpc : constant Name_Id := N + 076; - Name_Subp_Id : constant Name_Id := N + 077; - Name_Operation : constant Name_Id := N + 078; - Name_Argument : constant Name_Id := N + 079; - Name_Arg_Modes : constant Name_Id := N + 080; - Name_Handler : constant Name_Id := N + 081; - Name_Target : constant Name_Id := N + 082; - Name_Req : constant Name_Id := N + 083; - Name_Obj_TypeCode : constant Name_Id := N + 084; + Name_Addr : constant Name_Id := N + 065; + Name_Async : constant Name_Id := N + 066; + Name_Get_Active_Partition_ID : constant Name_Id := N + 067; + Name_Get_RCI_Package_Receiver : constant Name_Id := N + 068; + Name_Get_RCI_Package_Ref : constant Name_Id := N + 069; + Name_Origin : constant Name_Id := N + 070; + Name_Params : constant Name_Id := N + 071; + Name_Partition : constant Name_Id := N + 072; + Name_Partition_Interface : constant Name_Id := N + 073; + Name_Ras : constant Name_Id := N + 074; + Name_Call : constant Name_Id := N + 075; + Name_RCI_Name : constant Name_Id := N + 076; + Name_Receiver : constant Name_Id := N + 077; + Name_Result : constant Name_Id := N + 078; + Name_Rpc : constant Name_Id := N + 079; + Name_Subp_Id : constant Name_Id := N + 080; + Name_Operation : constant Name_Id := N + 081; + Name_Argument : constant Name_Id := N + 082; + Name_Arg_Modes : constant Name_Id := N + 083; + Name_Handler : constant Name_Id := N + 084; + Name_Target : constant Name_Id := N + 085; + Name_Req : constant Name_Id := N + 086; + Name_Obj_TypeCode : constant Name_Id := N + 087; -- Operator Symbol entries. The actual names have an upper case O at -- the start in place of the Op_ prefix (e.g. the actual name that -- corresponds to Name_Op_Abs is "Oabs". - First_Operator_Name : constant Name_Id := N + 085; - Name_Op_Abs : constant Name_Id := N + 085; -- "abs" - Name_Op_And : constant Name_Id := N + 086; -- "and" - Name_Op_Mod : constant Name_Id := N + 087; -- "mod" - Name_Op_Not : constant Name_Id := N + 088; -- "not" - Name_Op_Or : constant Name_Id := N + 089; -- "or" - Name_Op_Rem : constant Name_Id := N + 090; -- "rem" - Name_Op_Xor : constant Name_Id := N + 091; -- "xor" - Name_Op_Eq : constant Name_Id := N + 092; -- "=" - Name_Op_Ne : constant Name_Id := N + 093; -- "/=" - Name_Op_Lt : constant Name_Id := N + 094; -- "<" - Name_Op_Le : constant Name_Id := N + 095; -- "<=" - Name_Op_Gt : constant Name_Id := N + 096; -- ">" - Name_Op_Ge : constant Name_Id := N + 097; -- ">=" - Name_Op_Add : constant Name_Id := N + 098; -- "+" - Name_Op_Subtract : constant Name_Id := N + 099; -- "-" - Name_Op_Concat : constant Name_Id := N + 100; -- "&" - Name_Op_Multiply : constant Name_Id := N + 101; -- "*" - Name_Op_Divide : constant Name_Id := N + 102; -- "/" - Name_Op_Expon : constant Name_Id := N + 103; -- "**" - Last_Operator_Name : constant Name_Id := N + 103; + First_Operator_Name : constant Name_Id := N + 088; + Name_Op_Abs : constant Name_Id := N + 088; -- "abs" + Name_Op_And : constant Name_Id := N + 089; -- "and" + Name_Op_Mod : constant Name_Id := N + 090; -- "mod" + Name_Op_Not : constant Name_Id := N + 091; -- "not" + Name_Op_Or : constant Name_Id := N + 092; -- "or" + Name_Op_Rem : constant Name_Id := N + 093; -- "rem" + Name_Op_Xor : constant Name_Id := N + 094; -- "xor" + Name_Op_Eq : constant Name_Id := N + 095; -- "=" + Name_Op_Ne : constant Name_Id := N + 096; -- "/=" + Name_Op_Lt : constant Name_Id := N + 097; -- "<" + Name_Op_Le : constant Name_Id := N + 098; -- "<=" + Name_Op_Gt : constant Name_Id := N + 099; -- ">" + Name_Op_Ge : constant Name_Id := N + 100; -- ">=" + Name_Op_Add : constant Name_Id := N + 101; -- "+" + Name_Op_Subtract : constant Name_Id := N + 102; -- "-" + Name_Op_Concat : constant Name_Id := N + 103; -- "&" + Name_Op_Multiply : constant Name_Id := N + 104; -- "*" + Name_Op_Divide : constant Name_Id := N + 105; -- "/" + Name_Op_Expon : constant Name_Id := N + 106; -- "**" + Last_Operator_Name : constant Name_Id := N + 106; -- Names for all pragmas recognized by GNAT. The entries with the comment -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95. @@ -306,61 +312,61 @@ package Snames is -- only in GNAT for the AAMP. They are ignored in other versions with -- appropriate warnings. - First_Pragma_Name : constant Name_Id := N + 104; + First_Pragma_Name : constant Name_Id := N + 107; -- Configuration pragmas are grouped at start - Name_Ada_83 : constant Name_Id := N + 104; -- GNAT - Name_Ada_95 : constant Name_Id := N + 105; -- GNAT - Name_C_Pass_By_Copy : constant Name_Id := N + 106; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 107; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 108; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 109; -- GNAT - Name_Discard_Names : constant Name_Id := N + 110; - Name_Elaboration_Checks : constant Name_Id := N + 111; -- GNAT - Name_Eliminate : constant Name_Id := N + 112; -- GNAT - Name_Explicit_Overriding : constant Name_Id := N + 113; - Name_Extend_System : constant Name_Id := N + 114; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 115; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 116; -- GNAT - Name_Float_Representation : constant Name_Id := N + 117; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 118; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 119; -- GNAT - Name_License : constant Name_Id := N + 120; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 121; - Name_Long_Float : constant Name_Id := N + 122; -- VMS - Name_No_Run_Time : constant Name_Id := N + 123; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 124; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 125; - Name_Polling : constant Name_Id := N + 126; -- GNAT - Name_Persistent_Data : constant Name_Id := N + 127; -- GNAT - Name_Persistent_Object : constant Name_Id := N + 128; -- GNAT - Name_Profile : constant Name_Id := N + 129; -- Ada0Y - Name_Propagate_Exceptions : constant Name_Id := N + 130; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 131; - Name_Ravenscar : constant Name_Id := N + 132; - Name_Restricted_Run_Time : constant Name_Id := N + 133; - Name_Restrictions : constant Name_Id := N + 134; - Name_Restriction_Warnings : constant Name_Id := N + 135; -- GNAT - Name_Reviewable : constant Name_Id := N + 136; - Name_Source_File_Name : constant Name_Id := N + 137; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 138; -- GNAT - Name_Style_Checks : constant Name_Id := N + 139; -- GNAT - Name_Suppress : constant Name_Id := N + 140; - Name_Suppress_Exception_Locations : constant Name_Id := N + 141; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 142; - Name_Universal_Data : constant Name_Id := N + 143; -- AAMP - Name_Unsuppress : constant Name_Id := N + 144; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 145; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 146; -- GNAT - Name_Warnings : constant Name_Id := N + 147; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 147; + Name_Ada_83 : constant Name_Id := N + 107; -- GNAT + Name_Ada_95 : constant Name_Id := N + 108; -- GNAT + Name_C_Pass_By_Copy : constant Name_Id := N + 109; -- GNAT + Name_Compile_Time_Warning : constant Name_Id := N + 110; -- GNAT + Name_Component_Alignment : constant Name_Id := N + 111; -- GNAT + Name_Convention_Identifier : constant Name_Id := N + 112; -- GNAT + Name_Discard_Names : constant Name_Id := N + 113; + Name_Elaboration_Checks : constant Name_Id := N + 114; -- GNAT + Name_Eliminate : constant Name_Id := N + 115; -- GNAT + Name_Explicit_Overriding : constant Name_Id := N + 116; + Name_Extend_System : constant Name_Id := N + 117; -- GNAT + Name_Extensions_Allowed : constant Name_Id := N + 118; -- GNAT + Name_External_Name_Casing : constant Name_Id := N + 119; -- GNAT + Name_Float_Representation : constant Name_Id := N + 120; -- GNAT + Name_Initialize_Scalars : constant Name_Id := N + 121; -- GNAT + Name_Interrupt_State : constant Name_Id := N + 122; -- GNAT + Name_License : constant Name_Id := N + 123; -- GNAT + Name_Locking_Policy : constant Name_Id := N + 124; + Name_Long_Float : constant Name_Id := N + 125; -- VMS + Name_No_Run_Time : constant Name_Id := N + 126; -- GNAT + Name_No_Strict_Aliasing : constant Name_Id := N + 127; -- GNAT + Name_Normalize_Scalars : constant Name_Id := N + 128; + Name_Polling : constant Name_Id := N + 129; -- GNAT + Name_Persistent_Data : constant Name_Id := N + 130; -- GNAT + Name_Persistent_Object : constant Name_Id := N + 131; -- GNAT + Name_Profile : constant Name_Id := N + 132; -- Ada0Y + Name_Propagate_Exceptions : constant Name_Id := N + 133; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 134; + Name_Ravenscar : constant Name_Id := N + 135; + Name_Restricted_Run_Time : constant Name_Id := N + 136; + Name_Restrictions : constant Name_Id := N + 137; + Name_Restriction_Warnings : constant Name_Id := N + 138; -- GNAT + Name_Reviewable : constant Name_Id := N + 139; + Name_Source_File_Name : constant Name_Id := N + 140; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 141; -- GNAT + Name_Style_Checks : constant Name_Id := N + 142; -- GNAT + Name_Suppress : constant Name_Id := N + 143; + Name_Suppress_Exception_Locations : constant Name_Id := N + 144; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 145; + Name_Universal_Data : constant Name_Id := N + 146; -- AAMP + Name_Unsuppress : constant Name_Id := N + 147; -- GNAT + Name_Use_VADS_Size : constant Name_Id := N + 148; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 149; -- GNAT + Name_Warnings : constant Name_Id := N + 150; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 150; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 148; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 149; - Name_Annotate : constant Name_Id := N + 150; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 151; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 152; + Name_Annotate : constant Name_Id := N + 153; -- GNAT -- Note: AST_Entry is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -368,78 +374,78 @@ package Snames is -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry. -- AST_Entry is a VMS specific pragma. - Name_Assert : constant Name_Id := N + 151; -- GNAT - Name_Asynchronous : constant Name_Id := N + 152; - Name_Atomic : constant Name_Id := N + 153; - Name_Atomic_Components : constant Name_Id := N + 154; - Name_Attach_Handler : constant Name_Id := N + 155; - Name_Comment : constant Name_Id := N + 156; -- GNAT - Name_Common_Object : constant Name_Id := N + 157; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 158; -- GNAT - Name_Controlled : constant Name_Id := N + 159; - Name_Convention : constant Name_Id := N + 160; - Name_CPP_Class : constant Name_Id := N + 161; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 162; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 163; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 164; -- GNAT - Name_Debug : constant Name_Id := N + 165; -- GNAT - Name_Elaborate : constant Name_Id := N + 166; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 167; - Name_Elaborate_Body : constant Name_Id := N + 168; - Name_Export : constant Name_Id := N + 169; - Name_Export_Exception : constant Name_Id := N + 170; -- VMS - Name_Export_Function : constant Name_Id := N + 171; -- GNAT - Name_Export_Object : constant Name_Id := N + 172; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 173; -- GNAT - Name_Export_Value : constant Name_Id := N + 174; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 175; -- GNAT - Name_External : constant Name_Id := N + 176; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 177; -- GNAT - Name_Ident : constant Name_Id := N + 178; -- VMS - Name_Import : constant Name_Id := N + 179; - Name_Import_Exception : constant Name_Id := N + 180; -- VMS - Name_Import_Function : constant Name_Id := N + 181; -- GNAT - Name_Import_Object : constant Name_Id := N + 182; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 183; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 184; -- GNAT - Name_Inline : constant Name_Id := N + 185; - Name_Inline_Always : constant Name_Id := N + 186; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 187; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 188; - Name_Interface : constant Name_Id := N + 189; -- Ada 83 - Name_Interface_Name : constant Name_Id := N + 190; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 191; - Name_Interrupt_Priority : constant Name_Id := N + 192; - Name_Java_Constructor : constant Name_Id := N + 193; -- GNAT - Name_Java_Interface : constant Name_Id := N + 194; -- GNAT - Name_Keep_Names : constant Name_Id := N + 195; -- GNAT - Name_Link_With : constant Name_Id := N + 196; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 197; -- GNAT - Name_Linker_Options : constant Name_Id := N + 198; - Name_Linker_Section : constant Name_Id := N + 199; -- GNAT - Name_List : constant Name_Id := N + 200; - Name_Machine_Attribute : constant Name_Id := N + 201; -- GNAT - Name_Main : constant Name_Id := N + 202; -- GNAT - Name_Main_Storage : constant Name_Id := N + 203; -- GNAT - Name_Memory_Size : constant Name_Id := N + 204; -- Ada 83 - Name_No_Return : constant Name_Id := N + 205; -- GNAT - Name_Obsolescent : constant Name_Id := N + 206; -- GNAT - Name_Optimize : constant Name_Id := N + 207; - Name_Optional_Overriding : constant Name_Id := N + 208; - Name_Overriding : constant Name_Id := N + 209; - Name_Pack : constant Name_Id := N + 210; - Name_Page : constant Name_Id := N + 211; - Name_Passive : constant Name_Id := N + 212; -- GNAT - Name_Preelaborate : constant Name_Id := N + 213; - Name_Priority : constant Name_Id := N + 214; - Name_Psect_Object : constant Name_Id := N + 215; -- VMS - Name_Pure : constant Name_Id := N + 216; - Name_Pure_Function : constant Name_Id := N + 217; -- GNAT - Name_Remote_Call_Interface : constant Name_Id := N + 218; - Name_Remote_Types : constant Name_Id := N + 219; - Name_Share_Generic : constant Name_Id := N + 220; -- GNAT - Name_Shared : constant Name_Id := N + 221; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 222; + Name_Assert : constant Name_Id := N + 154; -- GNAT + Name_Asynchronous : constant Name_Id := N + 155; + Name_Atomic : constant Name_Id := N + 156; + Name_Atomic_Components : constant Name_Id := N + 157; + Name_Attach_Handler : constant Name_Id := N + 158; + Name_Comment : constant Name_Id := N + 159; -- GNAT + Name_Common_Object : constant Name_Id := N + 160; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 161; -- GNAT + Name_Controlled : constant Name_Id := N + 162; + Name_Convention : constant Name_Id := N + 163; + Name_CPP_Class : constant Name_Id := N + 164; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 165; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 166; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 167; -- GNAT + Name_Debug : constant Name_Id := N + 168; -- GNAT + Name_Elaborate : constant Name_Id := N + 169; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 170; + Name_Elaborate_Body : constant Name_Id := N + 171; + Name_Export : constant Name_Id := N + 172; + Name_Export_Exception : constant Name_Id := N + 173; -- VMS + Name_Export_Function : constant Name_Id := N + 174; -- GNAT + Name_Export_Object : constant Name_Id := N + 175; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 176; -- GNAT + Name_Export_Value : constant Name_Id := N + 177; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 178; -- GNAT + Name_External : constant Name_Id := N + 179; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 180; -- GNAT + Name_Ident : constant Name_Id := N + 181; -- VMS + Name_Import : constant Name_Id := N + 182; + Name_Import_Exception : constant Name_Id := N + 183; -- VMS + Name_Import_Function : constant Name_Id := N + 184; -- GNAT + Name_Import_Object : constant Name_Id := N + 185; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 186; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 187; -- GNAT + Name_Inline : constant Name_Id := N + 188; + Name_Inline_Always : constant Name_Id := N + 189; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 190; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 191; + Name_Interface : constant Name_Id := N + 192; -- Ada 83 + Name_Interface_Name : constant Name_Id := N + 193; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 194; + Name_Interrupt_Priority : constant Name_Id := N + 195; + Name_Java_Constructor : constant Name_Id := N + 196; -- GNAT + Name_Java_Interface : constant Name_Id := N + 197; -- GNAT + Name_Keep_Names : constant Name_Id := N + 198; -- GNAT + Name_Link_With : constant Name_Id := N + 199; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 200; -- GNAT + Name_Linker_Options : constant Name_Id := N + 201; + Name_Linker_Section : constant Name_Id := N + 202; -- GNAT + Name_List : constant Name_Id := N + 203; + Name_Machine_Attribute : constant Name_Id := N + 204; -- GNAT + Name_Main : constant Name_Id := N + 205; -- GNAT + Name_Main_Storage : constant Name_Id := N + 206; -- GNAT + Name_Memory_Size : constant Name_Id := N + 207; -- Ada 83 + Name_No_Return : constant Name_Id := N + 208; -- GNAT + Name_Obsolescent : constant Name_Id := N + 209; -- GNAT + Name_Optimize : constant Name_Id := N + 210; + Name_Optional_Overriding : constant Name_Id := N + 211; + Name_Overriding : constant Name_Id := N + 212; + Name_Pack : constant Name_Id := N + 213; + Name_Page : constant Name_Id := N + 214; + Name_Passive : constant Name_Id := N + 215; -- GNAT + Name_Preelaborate : constant Name_Id := N + 216; + Name_Priority : constant Name_Id := N + 217; + Name_Psect_Object : constant Name_Id := N + 218; -- VMS + Name_Pure : constant Name_Id := N + 219; + Name_Pure_Function : constant Name_Id := N + 220; -- GNAT + Name_Remote_Call_Interface : constant Name_Id := N + 221; + Name_Remote_Types : constant Name_Id := N + 222; + Name_Share_Generic : constant Name_Id := N + 223; -- GNAT + Name_Shared : constant Name_Id := N + 224; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 225; -- Note: Storage_Size is not in this list because its name matches the -- name of the corresponding attribute. However, it is included in the @@ -449,27 +455,27 @@ package Snames is -- Note: Storage_Unit is also omitted from the list because of a clash -- with an attribute name, and is treated similarly. - Name_Source_Reference : constant Name_Id := N + 223; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 224; -- GNAT - Name_Subtitle : constant Name_Id := N + 225; -- GNAT - Name_Suppress_All : constant Name_Id := N + 226; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 227; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 228; -- GNAT - Name_System_Name : constant Name_Id := N + 229; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 230; -- GNAT - Name_Task_Name : constant Name_Id := N + 231; -- GNAT - Name_Task_Storage : constant Name_Id := N + 232; -- VMS - Name_Thread_Body : constant Name_Id := N + 233; -- GNAT - Name_Time_Slice : constant Name_Id := N + 234; -- GNAT - Name_Title : constant Name_Id := N + 235; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 236; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 237; -- GNAT - Name_Unreferenced : constant Name_Id := N + 238; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 239; -- GNAT - Name_Volatile : constant Name_Id := N + 240; - Name_Volatile_Components : constant Name_Id := N + 241; - Name_Weak_External : constant Name_Id := N + 242; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 242; + Name_Source_Reference : constant Name_Id := N + 226; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 227; -- GNAT + Name_Subtitle : constant Name_Id := N + 228; -- GNAT + Name_Suppress_All : constant Name_Id := N + 229; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 230; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 231; -- GNAT + Name_System_Name : constant Name_Id := N + 232; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 233; -- GNAT + Name_Task_Name : constant Name_Id := N + 234; -- GNAT + Name_Task_Storage : constant Name_Id := N + 235; -- VMS + Name_Thread_Body : constant Name_Id := N + 236; -- GNAT + Name_Time_Slice : constant Name_Id := N + 237; -- GNAT + Name_Title : constant Name_Id := N + 238; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 239; -- GNAT + Name_Unimplemented_Unit : constant Name_Id := N + 240; -- GNAT + Name_Unreferenced : constant Name_Id := N + 241; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 242; -- GNAT + Name_Volatile : constant Name_Id := N + 243; + Name_Volatile_Components : constant Name_Id := N + 244; + Name_Weak_External : constant Name_Id := N + 245; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 245; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -480,98 +486,98 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 243; - Name_Ada : constant Name_Id := N + 243; - Name_Assembler : constant Name_Id := N + 244; - Name_COBOL : constant Name_Id := N + 245; - Name_CPP : constant Name_Id := N + 246; - Name_Fortran : constant Name_Id := N + 247; - Name_Intrinsic : constant Name_Id := N + 248; - Name_Java : constant Name_Id := N + 249; - Name_Stdcall : constant Name_Id := N + 250; - Name_Stubbed : constant Name_Id := N + 251; - Last_Convention_Name : constant Name_Id := N + 251; + First_Convention_Name : constant Name_Id := N + 246; + Name_Ada : constant Name_Id := N + 246; + Name_Assembler : constant Name_Id := N + 247; + Name_COBOL : constant Name_Id := N + 248; + Name_CPP : constant Name_Id := N + 249; + Name_Fortran : constant Name_Id := N + 250; + Name_Intrinsic : constant Name_Id := N + 251; + Name_Java : constant Name_Id := N + 252; + Name_Stdcall : constant Name_Id := N + 253; + Name_Stubbed : constant Name_Id := N + 254; + Last_Convention_Name : constant Name_Id := N + 254; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 252; - Name_Assembly : constant Name_Id := N + 253; + Name_Asm : constant Name_Id := N + 255; + Name_Assembly : constant Name_Id := N + 256; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 254; + Name_Default : constant Name_Id := N + 257; -- Name_Exernal (previously defined as pragma) -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 255; - Name_Win32 : constant Name_Id := N + 256; + Name_DLL : constant Name_Id := N + 258; + Name_Win32 : constant Name_Id := N + 259; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 257; - Name_Body_File_Name : constant Name_Id := N + 258; - Name_Casing : constant Name_Id := N + 259; - Name_Code : constant Name_Id := N + 260; - Name_Component : constant Name_Id := N + 261; - Name_Component_Size_4 : constant Name_Id := N + 262; - Name_Copy : constant Name_Id := N + 263; - Name_D_Float : constant Name_Id := N + 264; - Name_Descriptor : constant Name_Id := N + 265; - Name_Dot_Replacement : constant Name_Id := N + 266; - Name_Dynamic : constant Name_Id := N + 267; - Name_Entity : constant Name_Id := N + 268; - Name_External_Name : constant Name_Id := N + 269; - Name_First_Optional_Parameter : constant Name_Id := N + 270; - Name_Form : constant Name_Id := N + 271; - Name_G_Float : constant Name_Id := N + 272; - Name_Gcc : constant Name_Id := N + 273; - Name_Gnat : constant Name_Id := N + 274; - Name_GPL : constant Name_Id := N + 275; - Name_IEEE_Float : constant Name_Id := N + 276; - Name_Homonym_Number : constant Name_Id := N + 277; - Name_Internal : constant Name_Id := N + 278; - Name_Link_Name : constant Name_Id := N + 279; - Name_Lowercase : constant Name_Id := N + 280; - Name_Max_Size : constant Name_Id := N + 281; - Name_Mechanism : constant Name_Id := N + 282; - Name_Mixedcase : constant Name_Id := N + 283; - Name_Modified_GPL : constant Name_Id := N + 284; - Name_Name : constant Name_Id := N + 285; - Name_NCA : constant Name_Id := N + 286; - Name_No : constant Name_Id := N + 287; - Name_On : constant Name_Id := N + 288; - Name_Parameter_Types : constant Name_Id := N + 289; - Name_Reference : constant Name_Id := N + 290; - Name_No_Requeue : constant Name_Id := N + 291; - Name_No_Task_Attributes : constant Name_Id := N + 292; - Name_Restricted : constant Name_Id := N + 293; - Name_Result_Mechanism : constant Name_Id := N + 294; - Name_Result_Type : constant Name_Id := N + 295; - Name_Runtime : constant Name_Id := N + 296; - Name_SB : constant Name_Id := N + 297; - Name_Secondary_Stack_Size : constant Name_Id := N + 298; - Name_Section : constant Name_Id := N + 299; - Name_Semaphore : constant Name_Id := N + 300; - Name_Spec_File_Name : constant Name_Id := N + 301; - Name_Static : constant Name_Id := N + 302; - Name_Stack_Size : constant Name_Id := N + 303; - Name_Subunit_File_Name : constant Name_Id := N + 304; - Name_Task_Stack_Size_Default : constant Name_Id := N + 305; - Name_Task_Type : constant Name_Id := N + 306; - Name_Time_Slicing_Enabled : constant Name_Id := N + 307; - Name_Top_Guard : constant Name_Id := N + 308; - Name_UBA : constant Name_Id := N + 309; - Name_UBS : constant Name_Id := N + 310; - Name_UBSB : constant Name_Id := N + 311; - Name_Unit_Name : constant Name_Id := N + 312; - Name_Unknown : constant Name_Id := N + 313; - Name_Unrestricted : constant Name_Id := N + 314; - Name_Uppercase : constant Name_Id := N + 315; - Name_User : constant Name_Id := N + 316; - Name_VAX_Float : constant Name_Id := N + 317; - Name_VMS : constant Name_Id := N + 318; - Name_Working_Storage : constant Name_Id := N + 319; + Name_As_Is : constant Name_Id := N + 260; + Name_Body_File_Name : constant Name_Id := N + 261; + Name_Casing : constant Name_Id := N + 262; + Name_Code : constant Name_Id := N + 263; + Name_Component : constant Name_Id := N + 264; + Name_Component_Size_4 : constant Name_Id := N + 265; + Name_Copy : constant Name_Id := N + 266; + Name_D_Float : constant Name_Id := N + 267; + Name_Descriptor : constant Name_Id := N + 268; + Name_Dot_Replacement : constant Name_Id := N + 269; + Name_Dynamic : constant Name_Id := N + 270; + Name_Entity : constant Name_Id := N + 271; + Name_External_Name : constant Name_Id := N + 272; + Name_First_Optional_Parameter : constant Name_Id := N + 273; + Name_Form : constant Name_Id := N + 274; + Name_G_Float : constant Name_Id := N + 275; + Name_Gcc : constant Name_Id := N + 276; + Name_Gnat : constant Name_Id := N + 277; + Name_GPL : constant Name_Id := N + 278; + Name_IEEE_Float : constant Name_Id := N + 279; + Name_Homonym_Number : constant Name_Id := N + 280; + Name_Internal : constant Name_Id := N + 281; + Name_Link_Name : constant Name_Id := N + 282; + Name_Lowercase : constant Name_Id := N + 283; + Name_Max_Size : constant Name_Id := N + 284; + Name_Mechanism : constant Name_Id := N + 285; + Name_Mixedcase : constant Name_Id := N + 286; + Name_Modified_GPL : constant Name_Id := N + 287; + Name_Name : constant Name_Id := N + 288; + Name_NCA : constant Name_Id := N + 289; + Name_No : constant Name_Id := N + 290; + Name_On : constant Name_Id := N + 291; + Name_Parameter_Types : constant Name_Id := N + 292; + Name_Reference : constant Name_Id := N + 293; + Name_No_Requeue : constant Name_Id := N + 294; + Name_No_Task_Attributes : constant Name_Id := N + 295; + Name_Restricted : constant Name_Id := N + 296; + Name_Result_Mechanism : constant Name_Id := N + 297; + Name_Result_Type : constant Name_Id := N + 298; + Name_Runtime : constant Name_Id := N + 299; + Name_SB : constant Name_Id := N + 300; + Name_Secondary_Stack_Size : constant Name_Id := N + 301; + Name_Section : constant Name_Id := N + 302; + Name_Semaphore : constant Name_Id := N + 303; + Name_Spec_File_Name : constant Name_Id := N + 304; + Name_Static : constant Name_Id := N + 305; + Name_Stack_Size : constant Name_Id := N + 306; + Name_Subunit_File_Name : constant Name_Id := N + 307; + Name_Task_Stack_Size_Default : constant Name_Id := N + 308; + Name_Task_Type : constant Name_Id := N + 309; + Name_Time_Slicing_Enabled : constant Name_Id := N + 310; + Name_Top_Guard : constant Name_Id := N + 311; + Name_UBA : constant Name_Id := N + 312; + Name_UBS : constant Name_Id := N + 313; + Name_UBSB : constant Name_Id := N + 314; + Name_Unit_Name : constant Name_Id := N + 315; + Name_Unknown : constant Name_Id := N + 316; + Name_Unrestricted : constant Name_Id := N + 317; + Name_Uppercase : constant Name_Id := N + 318; + Name_User : constant Name_Id := N + 319; + Name_VAX_Float : constant Name_Id := N + 320; + Name_VMS : constant Name_Id := N + 321; + Name_Working_Storage : constant Name_Id := N + 322; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -585,158 +591,158 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 320; - Name_Abort_Signal : constant Name_Id := N + 320; -- GNAT - Name_Access : constant Name_Id := N + 321; - Name_Address : constant Name_Id := N + 322; - Name_Address_Size : constant Name_Id := N + 323; -- GNAT - Name_Aft : constant Name_Id := N + 324; - Name_Alignment : constant Name_Id := N + 325; - Name_Asm_Input : constant Name_Id := N + 326; -- GNAT - Name_Asm_Output : constant Name_Id := N + 327; -- GNAT - Name_AST_Entry : constant Name_Id := N + 328; -- VMS - Name_Bit : constant Name_Id := N + 329; -- GNAT - Name_Bit_Order : constant Name_Id := N + 330; - Name_Bit_Position : constant Name_Id := N + 331; -- GNAT - Name_Body_Version : constant Name_Id := N + 332; - Name_Callable : constant Name_Id := N + 333; - Name_Caller : constant Name_Id := N + 334; - Name_Code_Address : constant Name_Id := N + 335; -- GNAT - Name_Component_Size : constant Name_Id := N + 336; - Name_Compose : constant Name_Id := N + 337; - Name_Constrained : constant Name_Id := N + 338; - Name_Count : constant Name_Id := N + 339; - Name_Default_Bit_Order : constant Name_Id := N + 340; -- GNAT - Name_Definite : constant Name_Id := N + 341; - Name_Delta : constant Name_Id := N + 342; - Name_Denorm : constant Name_Id := N + 343; - Name_Digits : constant Name_Id := N + 344; - Name_Elaborated : constant Name_Id := N + 345; -- GNAT - Name_Emax : constant Name_Id := N + 346; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 347; -- GNAT - Name_Epsilon : constant Name_Id := N + 348; -- Ada 83 - Name_Exponent : constant Name_Id := N + 349; - Name_External_Tag : constant Name_Id := N + 350; - Name_First : constant Name_Id := N + 351; - Name_First_Bit : constant Name_Id := N + 352; - Name_Fixed_Value : constant Name_Id := N + 353; -- GNAT - Name_Fore : constant Name_Id := N + 354; - Name_Has_Discriminants : constant Name_Id := N + 355; -- GNAT - Name_Identity : constant Name_Id := N + 356; - Name_Img : constant Name_Id := N + 357; -- GNAT - Name_Integer_Value : constant Name_Id := N + 358; -- GNAT - Name_Large : constant Name_Id := N + 359; -- Ada 83 - Name_Last : constant Name_Id := N + 360; - Name_Last_Bit : constant Name_Id := N + 361; - Name_Leading_Part : constant Name_Id := N + 362; - Name_Length : constant Name_Id := N + 363; - Name_Machine_Emax : constant Name_Id := N + 364; - Name_Machine_Emin : constant Name_Id := N + 365; - Name_Machine_Mantissa : constant Name_Id := N + 366; - Name_Machine_Overflows : constant Name_Id := N + 367; - Name_Machine_Radix : constant Name_Id := N + 368; - Name_Machine_Rounds : constant Name_Id := N + 369; - Name_Machine_Size : constant Name_Id := N + 370; -- GNAT - Name_Mantissa : constant Name_Id := N + 371; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 372; - Name_Maximum_Alignment : constant Name_Id := N + 373; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 374; -- GNAT - Name_Model_Emin : constant Name_Id := N + 375; - Name_Model_Epsilon : constant Name_Id := N + 376; - Name_Model_Mantissa : constant Name_Id := N + 377; - Name_Model_Small : constant Name_Id := N + 378; - Name_Modulus : constant Name_Id := N + 379; - Name_Null_Parameter : constant Name_Id := N + 380; -- GNAT - Name_Object_Size : constant Name_Id := N + 381; -- GNAT - Name_Partition_ID : constant Name_Id := N + 382; - Name_Passed_By_Reference : constant Name_Id := N + 383; -- GNAT - Name_Pool_Address : constant Name_Id := N + 384; - Name_Pos : constant Name_Id := N + 385; - Name_Position : constant Name_Id := N + 386; - Name_Range : constant Name_Id := N + 387; - Name_Range_Length : constant Name_Id := N + 388; -- GNAT - Name_Round : constant Name_Id := N + 389; - Name_Safe_Emax : constant Name_Id := N + 390; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 391; - Name_Safe_Large : constant Name_Id := N + 392; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 393; - Name_Safe_Small : constant Name_Id := N + 394; -- Ada 83 - Name_Scale : constant Name_Id := N + 395; - Name_Scaling : constant Name_Id := N + 396; - Name_Signed_Zeros : constant Name_Id := N + 397; - Name_Size : constant Name_Id := N + 398; - Name_Small : constant Name_Id := N + 399; - Name_Storage_Size : constant Name_Id := N + 400; - Name_Storage_Unit : constant Name_Id := N + 401; -- GNAT - Name_Tag : constant Name_Id := N + 402; - Name_Target_Name : constant Name_Id := N + 403; -- GNAT - Name_Terminated : constant Name_Id := N + 404; - Name_To_Address : constant Name_Id := N + 405; -- GNAT - Name_Type_Class : constant Name_Id := N + 406; -- GNAT - Name_UET_Address : constant Name_Id := N + 407; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 408; - Name_Unchecked_Access : constant Name_Id := N + 409; - Name_Unconstrained_Array : constant Name_Id := N + 410; - Name_Universal_Literal_String : constant Name_Id := N + 411; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 412; -- GNAT - Name_VADS_Size : constant Name_Id := N + 413; -- GNAT - Name_Val : constant Name_Id := N + 414; - Name_Valid : constant Name_Id := N + 415; - Name_Value_Size : constant Name_Id := N + 416; -- GNAT - Name_Version : constant Name_Id := N + 417; - Name_Wchar_T_Size : constant Name_Id := N + 418; -- GNAT - Name_Wide_Width : constant Name_Id := N + 419; - Name_Width : constant Name_Id := N + 420; - Name_Word_Size : constant Name_Id := N + 421; -- GNAT + First_Attribute_Name : constant Name_Id := N + 323; + Name_Abort_Signal : constant Name_Id := N + 323; -- GNAT + Name_Access : constant Name_Id := N + 324; + Name_Address : constant Name_Id := N + 325; + Name_Address_Size : constant Name_Id := N + 326; -- GNAT + Name_Aft : constant Name_Id := N + 327; + Name_Alignment : constant Name_Id := N + 328; + Name_Asm_Input : constant Name_Id := N + 329; -- GNAT + Name_Asm_Output : constant Name_Id := N + 330; -- GNAT + Name_AST_Entry : constant Name_Id := N + 331; -- VMS + Name_Bit : constant Name_Id := N + 332; -- GNAT + Name_Bit_Order : constant Name_Id := N + 333; + Name_Bit_Position : constant Name_Id := N + 334; -- GNAT + Name_Body_Version : constant Name_Id := N + 335; + Name_Callable : constant Name_Id := N + 336; + Name_Caller : constant Name_Id := N + 337; + Name_Code_Address : constant Name_Id := N + 338; -- GNAT + Name_Component_Size : constant Name_Id := N + 339; + Name_Compose : constant Name_Id := N + 340; + Name_Constrained : constant Name_Id := N + 341; + Name_Count : constant Name_Id := N + 342; + Name_Default_Bit_Order : constant Name_Id := N + 343; -- GNAT + Name_Definite : constant Name_Id := N + 344; + Name_Delta : constant Name_Id := N + 345; + Name_Denorm : constant Name_Id := N + 346; + Name_Digits : constant Name_Id := N + 347; + Name_Elaborated : constant Name_Id := N + 348; -- GNAT + Name_Emax : constant Name_Id := N + 349; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 350; -- GNAT + Name_Epsilon : constant Name_Id := N + 351; -- Ada 83 + Name_Exponent : constant Name_Id := N + 352; + Name_External_Tag : constant Name_Id := N + 353; + Name_First : constant Name_Id := N + 354; + Name_First_Bit : constant Name_Id := N + 355; + Name_Fixed_Value : constant Name_Id := N + 356; -- GNAT + Name_Fore : constant Name_Id := N + 357; + Name_Has_Discriminants : constant Name_Id := N + 358; -- GNAT + Name_Identity : constant Name_Id := N + 359; + Name_Img : constant Name_Id := N + 360; -- GNAT + Name_Integer_Value : constant Name_Id := N + 361; -- GNAT + Name_Large : constant Name_Id := N + 362; -- Ada 83 + Name_Last : constant Name_Id := N + 363; + Name_Last_Bit : constant Name_Id := N + 364; + Name_Leading_Part : constant Name_Id := N + 365; + Name_Length : constant Name_Id := N + 366; + Name_Machine_Emax : constant Name_Id := N + 367; + Name_Machine_Emin : constant Name_Id := N + 368; + Name_Machine_Mantissa : constant Name_Id := N + 369; + Name_Machine_Overflows : constant Name_Id := N + 370; + Name_Machine_Radix : constant Name_Id := N + 371; + Name_Machine_Rounds : constant Name_Id := N + 372; + Name_Machine_Size : constant Name_Id := N + 373; -- GNAT + Name_Mantissa : constant Name_Id := N + 374; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 375; + Name_Maximum_Alignment : constant Name_Id := N + 376; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 377; -- GNAT + Name_Model_Emin : constant Name_Id := N + 378; + Name_Model_Epsilon : constant Name_Id := N + 379; + Name_Model_Mantissa : constant Name_Id := N + 380; + Name_Model_Small : constant Name_Id := N + 381; + Name_Modulus : constant Name_Id := N + 382; + Name_Null_Parameter : constant Name_Id := N + 383; -- GNAT + Name_Object_Size : constant Name_Id := N + 384; -- GNAT + Name_Partition_ID : constant Name_Id := N + 385; + Name_Passed_By_Reference : constant Name_Id := N + 386; -- GNAT + Name_Pool_Address : constant Name_Id := N + 387; + Name_Pos : constant Name_Id := N + 388; + Name_Position : constant Name_Id := N + 389; + Name_Range : constant Name_Id := N + 390; + Name_Range_Length : constant Name_Id := N + 391; -- GNAT + Name_Round : constant Name_Id := N + 392; + Name_Safe_Emax : constant Name_Id := N + 393; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 394; + Name_Safe_Large : constant Name_Id := N + 395; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 396; + Name_Safe_Small : constant Name_Id := N + 397; -- Ada 83 + Name_Scale : constant Name_Id := N + 398; + Name_Scaling : constant Name_Id := N + 399; + Name_Signed_Zeros : constant Name_Id := N + 400; + Name_Size : constant Name_Id := N + 401; + Name_Small : constant Name_Id := N + 402; + Name_Storage_Size : constant Name_Id := N + 403; + Name_Storage_Unit : constant Name_Id := N + 404; -- GNAT + Name_Tag : constant Name_Id := N + 405; + Name_Target_Name : constant Name_Id := N + 406; -- GNAT + Name_Terminated : constant Name_Id := N + 407; + Name_To_Address : constant Name_Id := N + 408; -- GNAT + Name_Type_Class : constant Name_Id := N + 409; -- GNAT + Name_UET_Address : constant Name_Id := N + 410; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 411; + Name_Unchecked_Access : constant Name_Id := N + 412; + Name_Unconstrained_Array : constant Name_Id := N + 413; + Name_Universal_Literal_String : constant Name_Id := N + 414; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 415; -- GNAT + Name_VADS_Size : constant Name_Id := N + 416; -- GNAT + Name_Val : constant Name_Id := N + 417; + Name_Valid : constant Name_Id := N + 418; + Name_Value_Size : constant Name_Id := N + 419; -- GNAT + Name_Version : constant Name_Id := N + 420; + Name_Wchar_T_Size : constant Name_Id := N + 421; -- GNAT + Name_Wide_Width : constant Name_Id := N + 422; + Name_Width : constant Name_Id := N + 423; + Name_Word_Size : constant Name_Id := N + 424; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value. - First_Renamable_Function_Attribute : constant Name_Id := N + 422; - Name_Adjacent : constant Name_Id := N + 422; - Name_Ceiling : constant Name_Id := N + 423; - Name_Copy_Sign : constant Name_Id := N + 424; - Name_Floor : constant Name_Id := N + 425; - Name_Fraction : constant Name_Id := N + 426; - Name_Image : constant Name_Id := N + 427; - Name_Input : constant Name_Id := N + 428; - Name_Machine : constant Name_Id := N + 429; - Name_Max : constant Name_Id := N + 430; - Name_Min : constant Name_Id := N + 431; - Name_Model : constant Name_Id := N + 432; - Name_Pred : constant Name_Id := N + 433; - Name_Remainder : constant Name_Id := N + 434; - Name_Rounding : constant Name_Id := N + 435; - Name_Succ : constant Name_Id := N + 436; - Name_Truncation : constant Name_Id := N + 437; - Name_Value : constant Name_Id := N + 438; - Name_Wide_Image : constant Name_Id := N + 439; - Name_Wide_Value : constant Name_Id := N + 440; - Last_Renamable_Function_Attribute : constant Name_Id := N + 440; + First_Renamable_Function_Attribute : constant Name_Id := N + 425; + Name_Adjacent : constant Name_Id := N + 425; + Name_Ceiling : constant Name_Id := N + 426; + Name_Copy_Sign : constant Name_Id := N + 427; + Name_Floor : constant Name_Id := N + 428; + Name_Fraction : constant Name_Id := N + 429; + Name_Image : constant Name_Id := N + 430; + Name_Input : constant Name_Id := N + 431; + Name_Machine : constant Name_Id := N + 432; + Name_Max : constant Name_Id := N + 433; + Name_Min : constant Name_Id := N + 434; + Name_Model : constant Name_Id := N + 435; + Name_Pred : constant Name_Id := N + 436; + Name_Remainder : constant Name_Id := N + 437; + Name_Rounding : constant Name_Id := N + 438; + Name_Succ : constant Name_Id := N + 439; + Name_Truncation : constant Name_Id := N + 440; + Name_Value : constant Name_Id := N + 441; + Name_Wide_Image : constant Name_Id := N + 442; + Name_Wide_Value : constant Name_Id := N + 443; + Last_Renamable_Function_Attribute : constant Name_Id := N + 443; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 441; - Name_Output : constant Name_Id := N + 441; - Name_Read : constant Name_Id := N + 442; - Name_Write : constant Name_Id := N + 443; - Last_Procedure_Attribute : constant Name_Id := N + 443; + First_Procedure_Attribute : constant Name_Id := N + 444; + Name_Output : constant Name_Id := N + 444; + Name_Read : constant Name_Id := N + 445; + Name_Write : constant Name_Id := N + 446; + Last_Procedure_Attribute : constant Name_Id := N + 446; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 444; - Name_Elab_Body : constant Name_Id := N + 444; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 445; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 446; + First_Entity_Attribute_Name : constant Name_Id := N + 447; + Name_Elab_Body : constant Name_Id := N + 447; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 448; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 449; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 447; - Name_Base : constant Name_Id := N + 447; - Name_Class : constant Name_Id := N + 448; - Last_Type_Attribute_Name : constant Name_Id := N + 448; - Last_Entity_Attribute_Name : constant Name_Id := N + 448; - Last_Attribute_Name : constant Name_Id := N + 448; + First_Type_Attribute_Name : constant Name_Id := N + 450; + Name_Base : constant Name_Id := N + 450; + Name_Class : constant Name_Id := N + 451; + Last_Type_Attribute_Name : constant Name_Id := N + 451; + Last_Entity_Attribute_Name : constant Name_Id := N + 451; + Last_Attribute_Name : constant Name_Id := N + 451; -- Names of recognized locking policy identifiers @@ -744,10 +750,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 449; - Name_Ceiling_Locking : constant Name_Id := N + 449; - Name_Inheritance_Locking : constant Name_Id := N + 450; - Last_Locking_Policy_Name : constant Name_Id := N + 450; + First_Locking_Policy_Name : constant Name_Id := N + 452; + Name_Ceiling_Locking : constant Name_Id := N + 452; + Name_Inheritance_Locking : constant Name_Id := N + 453; + Last_Locking_Policy_Name : constant Name_Id := N + 453; -- Names of recognized queuing policy identifiers. @@ -755,10 +761,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 451; - Name_FIFO_Queuing : constant Name_Id := N + 451; - Name_Priority_Queuing : constant Name_Id := N + 452; - Last_Queuing_Policy_Name : constant Name_Id := N + 452; + First_Queuing_Policy_Name : constant Name_Id := N + 454; + Name_FIFO_Queuing : constant Name_Id := N + 454; + Name_Priority_Queuing : constant Name_Id := N + 455; + Last_Queuing_Policy_Name : constant Name_Id := N + 455; -- Names of recognized task dispatching policy identifiers @@ -766,193 +772,193 @@ package Snames is -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 453; - Name_FIFO_Within_Priorities : constant Name_Id := N + 453; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 453; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 456; + Name_FIFO_Within_Priorities : constant Name_Id := N + 456; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 456; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 454; - Name_Access_Check : constant Name_Id := N + 454; - Name_Accessibility_Check : constant Name_Id := N + 455; - Name_Discriminant_Check : constant Name_Id := N + 456; - Name_Division_Check : constant Name_Id := N + 457; - Name_Elaboration_Check : constant Name_Id := N + 458; - Name_Index_Check : constant Name_Id := N + 459; - Name_Length_Check : constant Name_Id := N + 460; - Name_Overflow_Check : constant Name_Id := N + 461; - Name_Range_Check : constant Name_Id := N + 462; - Name_Storage_Check : constant Name_Id := N + 463; - Name_Tag_Check : constant Name_Id := N + 464; - Name_All_Checks : constant Name_Id := N + 465; - Last_Check_Name : constant Name_Id := N + 465; + First_Check_Name : constant Name_Id := N + 457; + Name_Access_Check : constant Name_Id := N + 457; + Name_Accessibility_Check : constant Name_Id := N + 458; + Name_Discriminant_Check : constant Name_Id := N + 459; + Name_Division_Check : constant Name_Id := N + 460; + Name_Elaboration_Check : constant Name_Id := N + 461; + Name_Index_Check : constant Name_Id := N + 462; + Name_Length_Check : constant Name_Id := N + 463; + Name_Overflow_Check : constant Name_Id := N + 464; + Name_Range_Check : constant Name_Id := N + 465; + Name_Storage_Check : constant Name_Id := N + 466; + Name_Tag_Check : constant Name_Id := N + 467; + Name_All_Checks : constant Name_Id := N + 468; + Last_Check_Name : constant Name_Id := N + 468; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Range). - Name_Abort : constant Name_Id := N + 466; - Name_Abs : constant Name_Id := N + 467; - Name_Accept : constant Name_Id := N + 468; - Name_And : constant Name_Id := N + 469; - Name_All : constant Name_Id := N + 470; - Name_Array : constant Name_Id := N + 471; - Name_At : constant Name_Id := N + 472; - Name_Begin : constant Name_Id := N + 473; - Name_Body : constant Name_Id := N + 474; - Name_Case : constant Name_Id := N + 475; - Name_Constant : constant Name_Id := N + 476; - Name_Declare : constant Name_Id := N + 477; - Name_Delay : constant Name_Id := N + 478; - Name_Do : constant Name_Id := N + 479; - Name_Else : constant Name_Id := N + 480; - Name_Elsif : constant Name_Id := N + 481; - Name_End : constant Name_Id := N + 482; - Name_Entry : constant Name_Id := N + 483; - Name_Exception : constant Name_Id := N + 484; - Name_Exit : constant Name_Id := N + 485; - Name_For : constant Name_Id := N + 486; - Name_Function : constant Name_Id := N + 487; - Name_Generic : constant Name_Id := N + 488; - Name_Goto : constant Name_Id := N + 489; - Name_If : constant Name_Id := N + 490; - Name_In : constant Name_Id := N + 491; - Name_Is : constant Name_Id := N + 492; - Name_Limited : constant Name_Id := N + 493; - Name_Loop : constant Name_Id := N + 494; - Name_Mod : constant Name_Id := N + 495; - Name_New : constant Name_Id := N + 496; - Name_Not : constant Name_Id := N + 497; - Name_Null : constant Name_Id := N + 498; - Name_Of : constant Name_Id := N + 499; - Name_Or : constant Name_Id := N + 500; - Name_Others : constant Name_Id := N + 501; - Name_Out : constant Name_Id := N + 502; - Name_Package : constant Name_Id := N + 503; - Name_Pragma : constant Name_Id := N + 504; - Name_Private : constant Name_Id := N + 505; - Name_Procedure : constant Name_Id := N + 506; - Name_Raise : constant Name_Id := N + 507; - Name_Record : constant Name_Id := N + 508; - Name_Rem : constant Name_Id := N + 509; - Name_Renames : constant Name_Id := N + 510; - Name_Return : constant Name_Id := N + 511; - Name_Reverse : constant Name_Id := N + 512; - Name_Select : constant Name_Id := N + 513; - Name_Separate : constant Name_Id := N + 514; - Name_Subtype : constant Name_Id := N + 515; - Name_Task : constant Name_Id := N + 516; - Name_Terminate : constant Name_Id := N + 517; - Name_Then : constant Name_Id := N + 518; - Name_Type : constant Name_Id := N + 519; - Name_Use : constant Name_Id := N + 520; - Name_When : constant Name_Id := N + 521; - Name_While : constant Name_Id := N + 522; - Name_With : constant Name_Id := N + 523; - Name_Xor : constant Name_Id := N + 524; + Name_Abort : constant Name_Id := N + 469; + Name_Abs : constant Name_Id := N + 470; + Name_Accept : constant Name_Id := N + 471; + Name_And : constant Name_Id := N + 472; + Name_All : constant Name_Id := N + 473; + Name_Array : constant Name_Id := N + 474; + Name_At : constant Name_Id := N + 475; + Name_Begin : constant Name_Id := N + 476; + Name_Body : constant Name_Id := N + 477; + Name_Case : constant Name_Id := N + 478; + Name_Constant : constant Name_Id := N + 479; + Name_Declare : constant Name_Id := N + 480; + Name_Delay : constant Name_Id := N + 481; + Name_Do : constant Name_Id := N + 482; + Name_Else : constant Name_Id := N + 483; + Name_Elsif : constant Name_Id := N + 484; + Name_End : constant Name_Id := N + 485; + Name_Entry : constant Name_Id := N + 486; + Name_Exception : constant Name_Id := N + 487; + Name_Exit : constant Name_Id := N + 488; + Name_For : constant Name_Id := N + 489; + Name_Function : constant Name_Id := N + 490; + Name_Generic : constant Name_Id := N + 491; + Name_Goto : constant Name_Id := N + 492; + Name_If : constant Name_Id := N + 493; + Name_In : constant Name_Id := N + 494; + Name_Is : constant Name_Id := N + 495; + Name_Limited : constant Name_Id := N + 496; + Name_Loop : constant Name_Id := N + 497; + Name_Mod : constant Name_Id := N + 498; + Name_New : constant Name_Id := N + 499; + Name_Not : constant Name_Id := N + 500; + Name_Null : constant Name_Id := N + 501; + Name_Of : constant Name_Id := N + 502; + Name_Or : constant Name_Id := N + 503; + Name_Others : constant Name_Id := N + 504; + Name_Out : constant Name_Id := N + 505; + Name_Package : constant Name_Id := N + 506; + Name_Pragma : constant Name_Id := N + 507; + Name_Private : constant Name_Id := N + 508; + Name_Procedure : constant Name_Id := N + 509; + Name_Raise : constant Name_Id := N + 510; + Name_Record : constant Name_Id := N + 511; + Name_Rem : constant Name_Id := N + 512; + Name_Renames : constant Name_Id := N + 513; + Name_Return : constant Name_Id := N + 514; + Name_Reverse : constant Name_Id := N + 515; + Name_Select : constant Name_Id := N + 516; + Name_Separate : constant Name_Id := N + 517; + Name_Subtype : constant Name_Id := N + 518; + Name_Task : constant Name_Id := N + 519; + Name_Terminate : constant Name_Id := N + 520; + Name_Then : constant Name_Id := N + 521; + Name_Type : constant Name_Id := N + 522; + Name_Use : constant Name_Id := N + 523; + Name_When : constant Name_Id := N + 524; + Name_While : constant Name_Id := N + 525; + Name_With : constant Name_Id := N + 526; + Name_Xor : constant Name_Id := N + 527; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Adress, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 525; - Name_Divide : constant Name_Id := N + 525; - Name_Enclosing_Entity : constant Name_Id := N + 526; - Name_Exception_Information : constant Name_Id := N + 527; - Name_Exception_Message : constant Name_Id := N + 528; - Name_Exception_Name : constant Name_Id := N + 529; - Name_File : constant Name_Id := N + 530; - Name_Import_Address : constant Name_Id := N + 531; - Name_Import_Largest_Value : constant Name_Id := N + 532; - Name_Import_Value : constant Name_Id := N + 533; - Name_Is_Negative : constant Name_Id := N + 534; - Name_Line : constant Name_Id := N + 535; - Name_Rotate_Left : constant Name_Id := N + 536; - Name_Rotate_Right : constant Name_Id := N + 537; - Name_Shift_Left : constant Name_Id := N + 538; - Name_Shift_Right : constant Name_Id := N + 539; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 540; - Name_Source_Location : constant Name_Id := N + 541; - Name_Unchecked_Conversion : constant Name_Id := N + 542; - Name_Unchecked_Deallocation : constant Name_Id := N + 543; - Name_To_Pointer : constant Name_Id := N + 544; - Last_Intrinsic_Name : constant Name_Id := N + 544; + First_Intrinsic_Name : constant Name_Id := N + 528; + Name_Divide : constant Name_Id := N + 528; + Name_Enclosing_Entity : constant Name_Id := N + 529; + Name_Exception_Information : constant Name_Id := N + 530; + Name_Exception_Message : constant Name_Id := N + 531; + Name_Exception_Name : constant Name_Id := N + 532; + Name_File : constant Name_Id := N + 533; + Name_Import_Address : constant Name_Id := N + 534; + Name_Import_Largest_Value : constant Name_Id := N + 535; + Name_Import_Value : constant Name_Id := N + 536; + Name_Is_Negative : constant Name_Id := N + 537; + Name_Line : constant Name_Id := N + 538; + Name_Rotate_Left : constant Name_Id := N + 539; + Name_Rotate_Right : constant Name_Id := N + 540; + Name_Shift_Left : constant Name_Id := N + 541; + Name_Shift_Right : constant Name_Id := N + 542; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 543; + Name_Source_Location : constant Name_Id := N + 544; + Name_Unchecked_Conversion : constant Name_Id := N + 545; + Name_Unchecked_Deallocation : constant Name_Id := N + 546; + Name_To_Pointer : constant Name_Id := N + 547; + Last_Intrinsic_Name : constant Name_Id := N + 547; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 545; - Name_Abstract : constant Name_Id := N + 545; - Name_Aliased : constant Name_Id := N + 546; - Name_Protected : constant Name_Id := N + 547; - Name_Until : constant Name_Id := N + 548; - Name_Requeue : constant Name_Id := N + 549; - Name_Tagged : constant Name_Id := N + 550; - Last_95_Reserved_Word : constant Name_Id := N + 550; + First_95_Reserved_Word : constant Name_Id := N + 548; + Name_Abstract : constant Name_Id := N + 548; + Name_Aliased : constant Name_Id := N + 549; + Name_Protected : constant Name_Id := N + 550; + Name_Until : constant Name_Id := N + 551; + Name_Requeue : constant Name_Id := N + 552; + Name_Tagged : constant Name_Id := N + 553; + Last_95_Reserved_Word : constant Name_Id := N + 553; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 551; + Name_Raise_Exception : constant Name_Id := N + 554; -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 552; - Name_Body_Suffix : constant Name_Id := N + 553; - Name_Builder : constant Name_Id := N + 554; - Name_Compiler : constant Name_Id := N + 555; - Name_Cross_Reference : constant Name_Id := N + 556; - Name_Default_Switches : constant Name_Id := N + 557; - Name_Exec_Dir : constant Name_Id := N + 558; - Name_Executable : constant Name_Id := N + 559; - Name_Executable_Suffix : constant Name_Id := N + 560; - Name_Extends : constant Name_Id := N + 561; - Name_Finder : constant Name_Id := N + 562; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 563; - Name_Gnatls : constant Name_Id := N + 564; - Name_Gnatstub : constant Name_Id := N + 565; - Name_Implementation : constant Name_Id := N + 566; - Name_Implementation_Exceptions : constant Name_Id := N + 567; - Name_Implementation_Suffix : constant Name_Id := N + 568; - Name_Languages : constant Name_Id := N + 569; - Name_Library_Dir : constant Name_Id := N + 570; - Name_Library_Auto_Init : constant Name_Id := N + 571; - Name_Library_GCC : constant Name_Id := N + 572; - Name_Library_Interface : constant Name_Id := N + 573; - Name_Library_Kind : constant Name_Id := N + 574; - Name_Library_Name : constant Name_Id := N + 575; - Name_Library_Options : constant Name_Id := N + 576; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 577; - Name_Library_Src_Dir : constant Name_Id := N + 578; - Name_Library_Symbol_File : constant Name_Id := N + 579; - Name_Library_Symbol_Policy : constant Name_Id := N + 580; - Name_Library_Version : constant Name_Id := N + 581; - Name_Linker : constant Name_Id := N + 582; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 583; - Name_Locally_Removed_Files : constant Name_Id := N + 584; - Name_Naming : constant Name_Id := N + 585; - Name_Object_Dir : constant Name_Id := N + 586; - Name_Pretty_Printer : constant Name_Id := N + 587; - Name_Project : constant Name_Id := N + 588; - Name_Separate_Suffix : constant Name_Id := N + 589; - Name_Source_Dirs : constant Name_Id := N + 590; - Name_Source_Files : constant Name_Id := N + 591; - Name_Source_List_File : constant Name_Id := N + 592; - Name_Spec : constant Name_Id := N + 593; - Name_Spec_Suffix : constant Name_Id := N + 594; - Name_Specification : constant Name_Id := N + 595; - Name_Specification_Exceptions : constant Name_Id := N + 596; - Name_Specification_Suffix : constant Name_Id := N + 597; - Name_Switches : constant Name_Id := N + 598; + Name_Binder : constant Name_Id := N + 555; + Name_Body_Suffix : constant Name_Id := N + 556; + Name_Builder : constant Name_Id := N + 557; + Name_Compiler : constant Name_Id := N + 558; + Name_Cross_Reference : constant Name_Id := N + 559; + Name_Default_Switches : constant Name_Id := N + 560; + Name_Exec_Dir : constant Name_Id := N + 561; + Name_Executable : constant Name_Id := N + 562; + Name_Executable_Suffix : constant Name_Id := N + 563; + Name_Extends : constant Name_Id := N + 564; + Name_Finder : constant Name_Id := N + 565; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 566; + Name_Gnatls : constant Name_Id := N + 567; + Name_Gnatstub : constant Name_Id := N + 568; + Name_Implementation : constant Name_Id := N + 569; + Name_Implementation_Exceptions : constant Name_Id := N + 570; + Name_Implementation_Suffix : constant Name_Id := N + 571; + Name_Languages : constant Name_Id := N + 572; + Name_Library_Dir : constant Name_Id := N + 573; + Name_Library_Auto_Init : constant Name_Id := N + 574; + Name_Library_GCC : constant Name_Id := N + 575; + Name_Library_Interface : constant Name_Id := N + 576; + Name_Library_Kind : constant Name_Id := N + 577; + Name_Library_Name : constant Name_Id := N + 578; + Name_Library_Options : constant Name_Id := N + 579; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 580; + Name_Library_Src_Dir : constant Name_Id := N + 581; + Name_Library_Symbol_File : constant Name_Id := N + 582; + Name_Library_Symbol_Policy : constant Name_Id := N + 583; + Name_Library_Version : constant Name_Id := N + 584; + Name_Linker : constant Name_Id := N + 585; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 586; + Name_Locally_Removed_Files : constant Name_Id := N + 587; + Name_Naming : constant Name_Id := N + 588; + Name_Object_Dir : constant Name_Id := N + 589; + Name_Pretty_Printer : constant Name_Id := N + 590; + Name_Project : constant Name_Id := N + 591; + Name_Separate_Suffix : constant Name_Id := N + 592; + Name_Source_Dirs : constant Name_Id := N + 593; + Name_Source_Files : constant Name_Id := N + 594; + Name_Source_List_File : constant Name_Id := N + 595; + Name_Spec : constant Name_Id := N + 596; + Name_Spec_Suffix : constant Name_Id := N + 597; + Name_Specification : constant Name_Id := N + 598; + Name_Specification_Exceptions : constant Name_Id := N + 599; + Name_Specification_Suffix : constant Name_Id := N + 600; + Name_Switches : constant Name_Id := N + 601; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 599; + Name_Unaligned_Valid : constant Name_Id := N + 602; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 599; + Last_Predefined_Name : constant Name_Id := N + 602; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; diff --git a/gcc/ada/targtyps.c b/gcc/ada/targtyps.c index 465edb6..0e81142 100644 --- a/gcc/ada/targtyps.c +++ b/gcc/ada/targtyps.c @@ -6,7 +6,7 @@ * * * Body * * * - * Copyright (C) 1992-2003 Free Software Foundation, Inc. * + * Copyright (C) 1992-2004 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- * @@ -148,16 +148,6 @@ get_target_maximum_alignment (void) return BIGGEST_ALIGNMENT / BITS_PER_UNIT; } -Boolean -get_target_no_dollar_in_label (void) -{ -#ifdef NO_DOLLAR_IN_LABEL - return 1; -#else - return 0; -#endif -} - #ifndef FLOAT_WORDS_BIG_ENDIAN #define FLOAT_WORDS_BIG_ENDIAN WORDS_BIG_ENDIAN #endif diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index ac6e162..3e3d6b5 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -2994,11 +2994,13 @@ convert (tree type, tree expr) case STRING_CST: case CONSTRUCTOR: /* If we are converting a STRING_CST to another constrained array type, - just make a new one in the proper type. Likewise for a - CONSTRUCTOR. */ + just make a new one in the proper type. Likewise for + CONSTRUCTOR if the alias sets are the same. */ if (code == ecode && AGGREGATE_TYPE_P (etype) && ! (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST - && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)) + && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST) + && (TREE_CODE (expr) == STRING_CST + || get_alias_set (etype) == get_alias_set (type))) { expr = copy_node (expr); TREE_TYPE (expr) = type; @@ -3014,7 +3016,8 @@ convert (tree type, tree expr) if (code == ecode && TYPE_MODE (type) == TYPE_MODE (etype) && AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype) && TYPE_ALIGN (type) == TYPE_ALIGN (etype) - && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0)) + && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0) + && get_alias_set (type) == get_alias_set (etype)) return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0), TREE_OPERAND (expr, 1)); -- cgit v1.1