diff options
Diffstat (limited to 'gcc/ada')
47 files changed, 639 insertions, 284 deletions
diff --git a/gcc/ada/5qsystem.ads b/gcc/ada/5qsystem.ads index cfbba6d5c53..c8b94936ded 100644 --- a/gcc/ada/5qsystem.ads +++ b/gcc/ada/5qsystem.ads @@ -63,9 +63,6 @@ pragma Pure (System); -- Storage-related Declarations type Address is new Long_Integer; - subtype Short_Address is Address - range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1; - for Short_Address'Object_Size use 32; Null_Address : constant Address; Storage_Unit : constant := 8; diff --git a/gcc/ada/5vinmaop.adb b/gcc/ada/5vinmaop.adb index 42207a1ce10..2cbfd0eb715 100644 --- a/gcc/ada/5vinmaop.adb +++ b/gcc/ada/5vinmaop.adb @@ -37,6 +37,9 @@ with System.OS_Interface; -- used for various type, constant, and operations +with System.Aux_DEC; +-- used for Short_Address + with System.Parameters; with System.Tasking; @@ -114,7 +117,7 @@ package body System.Interrupt_Management.Operations is -------------------- function To_unsigned_long is new - Unchecked_Conversion (System.Short_Address, unsigned_long); + Unchecked_Conversion (System.Aux_DEC.Short_Address, unsigned_long); function Interrupt_Wait (Mask : access Interrupt_Mask) return Interrupt_ID diff --git a/gcc/ada/5vsystem.ads b/gcc/ada/5vsystem.ads index 9bf3b5f2698..fc4fb2e6d6f 100644 --- a/gcc/ada/5vsystem.ads +++ b/gcc/ada/5vsystem.ads @@ -63,7 +63,6 @@ pragma Pure (System); -- Storage-related Declarations type Address is private; - subtype Short_Address is Address; Null_Address : constant Address; Storage_Unit : constant := 8; diff --git a/gcc/ada/5xsystem.ads b/gcc/ada/5xsystem.ads index a716fa1a708..3ba5e692195 100644 --- a/gcc/ada/5xsystem.ads +++ b/gcc/ada/5xsystem.ads @@ -63,7 +63,6 @@ pragma Pure (System); -- Storage-related Declarations type Address is private; - subtype Short_Address is Address; Null_Address : constant Address; Storage_Unit : constant := 8; diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c1531aa9093..6c3ddc3eef9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,147 @@ +2004-05-10 Doug Rupp <rupp@gnat.com> + + * 5qsystem.ads: Remove Short_Address subtype declaration. Moved to + system.aux_dec. + + * s-auxdec.ads: Add Short_Address subtype (moved here from System). + + * Makefile.in: [VMS]: Add translation for 5qauxdec.ads. + + * init.c: [VMS] Macroize LIB$ calls for IA64 and Alpha. + Fixes undefined symbols in IA64 gnatlib. + + * 5vinmaop.adb: Reference s-auxdec for Short_Address. + + * 5xsystem.ads, 5vsystem.ads: Back out last change (addition of subtype + Short_Address). This will be moved to system.auxdec. + +2004-05-10 Thomas Quinot <quinot@act-europe.fr> + + * sem_util.adb: Replace test for presence of a node that is always + present with a call to Discard_Node. + + * sem_ch10.adb (Analyze_Compilation_Unit): Remove superfluous call to + Analyze on the library unit node after generation of distribution stub + constructs. The call was a no-op because Unit_Node has already been + Analyzed, and the tree fragments for the distribution stubs are + analyzed as they are inserted in Exp_Dist. + Update comment regarding to distribution stubs to reflect that we + do not generate stub in separate files anymore. + + * einfo.ads: Clarify the fact that a tagged private type has the + E_Record_Type_With_Private Ekind. + + * erroutc.adb: Minor reformatting + + * erroutc.ads (Max_Msg_Length): Increase to cover possible larger + values if line length is increased using -gnatyM (noticed during code + reading). + + * eval_fat.adb: Minor reformatting + Put spaces around exponentiation operator + +2004-05-10 Ed Schonberg <schonberg@gnat.com> + + PR ada/15005 + * sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): If prefix + has been rewritten as an explicit dereference, retrieve type of + original node to check for possibly unconstrained record type. + +2004-05-10 Ed Schonberg <schonberg@gnat.com> + + * exp_ch7.adb (Check_Visibly_Controlled): If given operation is not + overriding, use the operation of the parent unconditionally. + + * sem_ch4.adb (Remove_Address_Interpretations): Remove address + operation when either operand is a literal, to avoid further + ambiguities. + + * sem_ch6.adb (New_Overloaded_Entity): If new entity is inherited and + overridden by a previous explicit declaration, mark the previous entity + as overriding. + + * sem_disp.adb (Check_Dispatching_Operation): New predicate + Is_Visibly_Controlled, to determine whether a declaration of a + primitive control operation for a derived type overrides an inherited + one. Add warning if the explicit declaration does not override. + +2004-05-10 Vincent Celier <celier@gnat.com> + + * gnatls.adb (Gnatls): Initialize Snames, to avoid assertion error in + some cases when the sources are no longer present. + + * make.adb (Collect_Arguments): Fail if an external source, not part + of any project need to be compiled, when switch -x has not been + specified. + + * makeusg.adb: Document new switch -x + + * opt.ads (External_Unit_Compilation_Allowed): New Boolean flag, + defaulted to False. + + * switch-m.adb (Scan_Make_Switches): New switch -x + + * vms_data.ads: Add VMS qualifier /NON_PROJECT_UNIT_COMPILATION for + gnatmake switch -x. + + * gnat_ugn.texi: Document new gnatmake switch -x + +2004-05-10 Eric Botcazou <ebotcazou@act-europe.fr> + + * misc.c (gnat_init_options): Set flag_zero_initialized_in_bss to 0. + + * utils.c (create_var_decl): Do not modify the DECL_COMMON flag. + (process_attributes): Likewise. + +2004-05-10 Joel Brobecker <brobecker@gnat.com> + + * s-inmaop.ads: Fix spelling mistake in one of the comments. + +2004-05-10 Robert Dewar <dewar@gnat.com> + + * gnat_ugn.texi: Document that for config pragma files, the maximum + line length is always 32767. + + * gnat_rm.texi: For pragma Eliminate, note that concatenation of string + literals is now allowed. + + * gnat-style.texi: Remove statement about splitting long lines before + an operator rather than after, since we do not follow this rule at all. + Clarify rule (really lack of rule) for spaces around exponentiation + + * sem_elim.adb: Allow concatenation of string literals as well as a + single string literal for pragma arguments. + + * sem_prag.ads, sem_prag.adb: (Is_Config_Static_String): New function + + * a-textio.adb (Terminate_Line): Do not add line feed if nothing + written for append case. + + * frontend.adb: Changes to avoid checking max line length in config + pragma files. + + * g-os_lib.ads: Minor reformatting + + * mlib-utl.adb: Do not define Max_Line_Length locally (definition was + wrong in any case. Instead use standard value. Noticed during code + reading. + + * opt.ads (Max_Line_Length): New field, used to implement removal of + limitation on length of lines when scanning config pragma files. + + * osint.ads, prj-dect.adb, prj-strt.adb, prj-tree.adb, + makeutl.ads, makeutl.adb: Minor reformatting + + * scn.adb: Do not check line length while scanning config pragma files + Do not check line length while scanning out license information + + * scng.adb: Changes to avoid line length checks while parsing config + pragma files. + +2004-05-10 GNAT Script <nobody@gnat.com> + + * Make-lang.in: Makefile automatically updated + 2004-05-05 Arnaud Charlet <charlet@act-europe.fr> * osint.adb (Find_Program_Name): Fix handling of VMS version diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index 5cf5d62d425..0a6775a438f 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -1698,10 +1698,9 @@ ada/exp_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_ch7.adb \ ada/exp_ch9.ads ada/exp_dbug.ads ada/exp_tss.ads ada/exp_util.ads \ ada/exp_util.adb ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ - ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \ - ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \ - ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ - ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \ + ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \ + ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \ + ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \ ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \ ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \ @@ -3261,14 +3260,15 @@ ada/sem_elim.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \ ada/errout.ads ada/erroutc.ads ada/gnat.ads ada/g-htable.ads \ ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \ ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \ - ada/sem_elim.ads ada/sem_elim.adb ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \ - ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ - ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads + ada/sem_elim.ads ada/sem_elim.adb ada/sem_prag.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \ + ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/sem_eval.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index f35622436fe..6b075b8a3d3 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -1145,6 +1145,7 @@ endif ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),) ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),) LIBGNAT_TARGET_PAIRS_AUX1 = \ + s-auxdec.ads<5qauxdec.ads \ s-crtl.ads<5xcrtl.ads \ s-osinte.adb<5xosinte.adb \ s-osinte.ads<5xosinte.ads \ diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb index 98766ce9bf3..7afb804ff9c 100644 --- a/gcc/ada/a-textio.adb +++ b/gcc/ada/a-textio.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- -- @@ -1678,8 +1678,12 @@ package body Ada.Text_IO is -- because it is too much of a nuisance to have these odd line -- feeds when nothing has been written to the file. + -- We also avoid this for files opened in append mode, in + -- accordance with (RM A.8.2(10)) + elsif (File /= Standard_Err and then File /= Standard_Out) and then (File.Line = 1 and then File.Page = 1) + and then Mode (File) = Out_File then New_Line (File); end if; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9548da438ff..6487a22012e 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3383,18 +3383,19 @@ package Einfo is -- A record subtype, created by a record subtype declaration. E_Record_Type_With_Private, - -- Used for types defined by a private extension declaration. Includes - -- the fields for both private types and for record types (with the - -- sole exception of Corresponding_Concurrent_Type which is obviously - -- not needed). This entity is considered to be both a record type and + -- Used for types defined by a private extension declaration, and + -- for tagged private types. Includes the fields for both private + -- types and for record types (with the sole exception of + -- Corresponding_Concurrent_Type which is obviously not needed). + -- This entity is considered to be both a record type and -- a private type. E_Record_Subtype_With_Private, -- A subtype of a type defined by a private extension declaration. E_Private_Type, - -- A private type, created by a private type declaration that does - -- not have the keyword limited. + -- A private type, created by a private type declaration + -- that has neither the keyword limited nor the keyword tagged. E_Private_Subtype, -- A subtype of a private type, created by a subtype declaration used @@ -3402,7 +3403,7 @@ package Einfo is E_Limited_Private_Type, -- A limited private type, created by a private type declaration that - -- has the keyword limited. + -- has the keyword limited, but not the keyword tagged. E_Limited_Private_Subtype, -- A subtype of a limited private type, created by a subtype declaration diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index e46c7cd6314..31c97d5bc55 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.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- -- @@ -33,7 +33,6 @@ with Casing; use Casing; with Debug; use Debug; with Err_Vars; use Err_Vars; -with Hostparm; with Namet; use Namet; with Opt; use Opt; with Output; use Output; @@ -71,7 +70,6 @@ package body Erroutc is function Buffer_Ends_With (S : String) return Boolean is Len : constant Natural := S'Length; - begin return Msglen > Len @@ -466,6 +464,10 @@ package body Erroutc is -- Returns True for a message that is to be purged. Also adjusts -- error counts appropriately. + ------------------ + -- To_Be_Purged -- + ------------------ + function To_Be_Purged (E : Error_Msg_Id) return Boolean is begin if E /= No_Error_Msg diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index b0af72df446..cde38932df3 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -27,7 +27,6 @@ -- This packages contains global variables and routines common to error -- reporting packages, including Errout and Prj.Err. -with Hostparm; with Table; with Types; use Types; @@ -77,11 +76,12 @@ package Erroutc is Manual_Quote_Mode : Boolean := False; -- Set True in manual quotation mode - Max_Msg_Length : constant := 256 + 2 * Hostparm.Max_Line_Length; - -- Maximum length of error message. The addition of Max_Line_Length + Max_Msg_Length : constant := 1024 + 2 * Int (Column_Number'Last); + -- Maximum length of error message. The addition of 2 * Column_Number'Last -- ensures that two insertion tokens of maximum length can be accomodated. - -- The value of 256 is an arbitrary value that should be more than long - -- enough to accomodate any reasonable message. + -- The value of 1024 is an arbitrary value that should be more than long + -- enough to accomodate any reasonable message (and for that matter, some + -- pretty unreasonable messages!) Msg_Buffer : String (1 .. Max_Msg_Length); -- Buffer used to prepare error messages diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb index d083c32ba5c..2d439930301 100644 --- a/gcc/ada/eval_fat.adb +++ b/gcc/ada/eval_fat.adb @@ -40,8 +40,8 @@ package body Eval_Fat is type Radix_Power_Table is array (Int range 1 .. 4) of Int; - Radix_Powers : constant Radix_Power_Table - := (Radix**1, Radix**2, Radix**3, Radix**4); + Radix_Powers : constant Radix_Power_Table := + (Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4); function Float_Radix return T renames Ureal_2; -- Radix expressed in real form diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e78d9954082..287b4efc792 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -37,10 +37,8 @@ with Exp_Ch11; use Exp_Ch11; with Exp_Dbug; use Exp_Dbug; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; -with Fname; use Fname; with Freeze; use Freeze; with Hostparm; use Hostparm; -with Lib; use Lib; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; @@ -818,28 +816,16 @@ package body Exp_Ch7 is begin if Is_Derived_Type (Typ) and then Comes_From_Source (E) - and then Is_Overriding_Operation (E) - and then - (not Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Root_Type (Typ))))) + and then not Is_Overriding_Operation (E) then - -- We know that the explicit operation on the type overrode + -- We know that the explicit operation on the type does not override -- the inherited operation of the parent, and that the derivation -- is from a private type that is not visibly controlled. Parent_Type := Etype (Typ); Op := Find_Prim_Op (Parent_Type, Name_Of (Prim)); - if Present (Op) - and then Is_Hidden (Op) - and then Scope (Scope (Typ)) /= Scope (Op) - and then not In_Open_Scopes (Scope (Typ)) - then - -- If the parent operation is not visible, and the derived - -- type is not declared in a child unit, then the explicit - -- operation does not override, and we must use the operation - -- of the parent. - + if Present (Op) then E := Op; -- Wrap the object to be initialized into the proper diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index f4f36f56aaf..35645bd0812 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.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- -- @@ -124,10 +124,12 @@ begin begin -- We always analyze config files with style checks off, since -- we don't want a miscellaneous gnat.adc that is around to - -- discombobulate intended -gnatg or -gnaty compilations. + -- discombobulate intended -gnatg or -gnaty compilations. We + -- also disconnect checking for maximum line length. Opt.Style_Check := False; Style_Check := False; + Opt.Max_Line_Length := Int (Column_Number'Last); -- Capture current suppress options, which may get modified @@ -191,6 +193,7 @@ begin -- Restore style check, but if config file turned on checks, leave on! Opt.Style_Check := Save_Style_Check or Style_Check; + Opt.Max_Line_Length := Hostparm.Max_Line_Length; -- Capture any modifications to suppress options from config pragmas diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads index a8968c25c6c..bd4201fc5f7 100644 --- a/gcc/ada/g-os_lib.ads +++ b/gcc/ada/g-os_lib.ads @@ -93,6 +93,7 @@ pragma Elaborate_Body (OS_Lib); -- Time/Date Stuff -- --------------------- + type OS_Time is private; -- The OS's notion of time is represented by the private type OS_Time. -- This is the type returned by the File_Time_Stamp functions to obtain -- the time stamp of a specified file. Functions and a procedure (modeled @@ -102,8 +103,8 @@ pragma Elaborate_Body (OS_Lib); -- cases but rather the actual (time-zone independent) time stamp of the -- file (of course in Unix systems, this *is* in GMT form). - type OS_Time is private; Invalid_Time : constant OS_Time; + -- A special unique value used to flag an invalid time stamp value subtype Year_Type is Integer range 1900 .. 2099; subtype Month_Type is Integer range 1 .. 12; @@ -111,6 +112,8 @@ pragma Elaborate_Body (OS_Lib); subtype Hour_Type is Integer range 0 .. 23; subtype Minute_Type is Integer range 0 .. 59; subtype Second_Type is Integer range 0 .. 59; + -- Declarations similar to those in Calendar, breaking down the time + function GM_Year (Date : OS_Time) return Year_Type; function GM_Month (Date : OS_Time) return Month_Type; @@ -118,6 +121,7 @@ pragma Elaborate_Body (OS_Lib); function GM_Hour (Date : OS_Time) return Hour_Type; function GM_Minute (Date : OS_Time) return Minute_Type; function GM_Second (Date : OS_Time) return Second_Type; + -- Functions to extract information from OS_Time value function "<" (X, Y : OS_Time) return Boolean; function ">" (X, Y : OS_Time) return Boolean; @@ -135,6 +139,8 @@ pragma Elaborate_Body (OS_Lib); Hour : out Hour_Type; Minute : out Minute_Type; Second : out Second_Type); + -- Analogous to the routine of similar name in Calendar, takes an OS_Time + -- and splits it into its component parts with obvious meanings. ---------------- -- File Stuff -- diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi index 2fa09412589..ee425de5f29 100644 --- a/gcc/ada/gnat-style.texi +++ b/gcc/ada/gnat-style.texi @@ -382,8 +382,11 @@ one context, where comments explain their purpose. @itemize @bullet @item -Every operator must be surrounded by spaces, except for the -exponentiation operator. +Every operator must be surrounded by spaces. An exception is that +this rule does not apply to the exponentiation operator, for which +there are no specific layout rules. The reason for this exception +is that sometimes it makes clearer reading to leave out the spaces +around exponentiation. @cindex Operators @smallexample @c adanocomment @@ -391,9 +394,6 @@ exponentiation operator. @end smallexample @item -When folding a long line, fold before an operator, not after. - -@item Use parentheses where they clarify the intended association of operands with operators: @cindex Parenthesization of expressions diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index ec766614392..614064ff313 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -1356,10 +1356,12 @@ FUNCTION_PROFILE ::= [Parameter_Types => PARAMETER_TYPES,] Result_Type => result_SUBTYPE_NAME] PARAMETER_TYPES ::= (SUBTYPE_NAME @{, SUBTYPE_NAME@}) -SUBTYPE_NAME ::= STRING_LITERAL +SUBTYPE_NAME ::= STRING_VALUE SOURCE_LOCATION ::= Source_Location => SOURCE_TRACE -SOURCE_TRACE ::= STRING_LITERAL +SOURCE_TRACE ::= STRING_VALUE + +STRING_VALUE ::= STRING_LITERAL @{& STRING_LITERAL@} @end smallexample @noindent @@ -1388,7 +1390,7 @@ 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 +always given as strings. At the moment, this form of distinguishing overloaded subprograms is implemented only partially, so we do not recommend using it for practical subprogram elimination. @@ -1398,8 +1400,8 @@ 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: +source text. The string literal (or concatenation of string literals) +given as SOURCE_TRACE must have the following format: @smallexample @c ada SOURCE_TRACE ::= SOURCE_LOCATION@{LBRACKET SOURCE_LOCATION RBRACKET@} diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 2b908fb2e8b..5ae1a892124 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -8334,6 +8334,15 @@ decides are necessary. Indicates the verbosity of the parsing of GNAT project files. See @ref{Switches Related to Project Files}. +@item ^-x^/NON_PROJECT_UNIT_COMPILATION^ +@cindex @option{^-x^/NON_PROJECT_UNIT_COMPILATION^} (@code{gnatmake}) +Indicates that sources that are not part of any Project File may be compiled. +Normally, when using Project Files, only sources that are part of a Project +File may be compile. When this switch is used, a source outside of all Project +Files may be compiled. The ALI file and the object file will be put in the +object directory of the main Project. The compilation switches used will only +be those specified on the command line. + @item ^-X^/EXTERNAL_REFERENCE=^@var{name=value} Indicates that external variable @var{name} has the value @var{value}. The Project Manager will use this value for occurrences of @@ -17566,7 +17575,9 @@ by @command{gnatstub} to compile an argument source file. @cindex @option{^-gnatyM^/MAX_LINE_LENGTH^} (@command{gnatstub}) (@var{n} is a non-negative integer). Set the maximum line length in the body stub to @var{n}; the default is 79. The maximum value that can be -specified is 32767. +specified is 32767. Note that in the special case of configuration +pragma files, the maximum is always 32767 regardless of whether or +not this switch appears. @item ^-gnaty^/STYLE_CHECKS=^@var{n} @cindex @option{^-gnaty^/STYLE_CHECKS=^} (@command{gnatstub}) diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 6b3d07e7065..1e491f2a7d3 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -38,6 +38,7 @@ with Osint; use Osint; with Osint.L; use Osint.L; with Output; use Output; with Rident; use Rident; +with Snames; with Targparm; use Targparm; with Types; use Types; @@ -938,6 +939,7 @@ begin Namet.Initialize; Csets.Initialize; + Snames.Initialize; -- Loop to scan out arguments diff --git a/gcc/ada/init.c b/gcc/ada/init.c index e43821eab67..b27e059ed9d 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1281,7 +1281,17 @@ __gnat_initialize (void) #elif defined (VMS) -#ifdef IN_RTS +#ifdef __IA64 +#define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT +#define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT +#define lib_get_invo_handle LIB$I64_GET_INVO_HANDLE +#else +#define lib_get_curr_invo_context LIB$GET_CURR_INVO_CONTEXT +#define lib_get_prev_invo_context LIB$GET_PREV_INVO_CONTEXT +#define lib_get_invo_handle LIB$GET_INVO_HANDLE +#endif + +#if defined (IN_RTS) && !defined (__IA64) /* The prehandler actually gets control first on a condition. It swaps the stack pointer and calls the handler (__gnat_error_handler). */ @@ -1464,10 +1474,10 @@ __gnat_error_handler (int *sigargs, void *mechargs) mstate = (long *) (*Get_Machine_State_Addr) (); if (mstate != 0) { - LIB$GET_CURR_INVO_CONTEXT (&curr_icb); - LIB$GET_PREV_INVO_CONTEXT (&curr_icb); - LIB$GET_PREV_INVO_CONTEXT (&curr_icb); - curr_invo_handle = LIB$GET_INVO_HANDLE (&curr_icb); + lib_get_curr_invo_context (&curr_icb); + lib_get_prev_invo_context (&curr_icb); + lib_get_prev_invo_context (&curr_icb); + curr_invo_handle = lib_get_invo_handle (&curr_icb); *mstate = curr_invo_handle; } Raise_From_Signal_Handler (exception, msg); @@ -1477,7 +1487,7 @@ void __gnat_install_handler (void) { long prvhnd; -#ifdef IN_RTS +#if defined (IN_RTS) && !defined (__IA64) char *c; c = (char *) xmalloc (2049); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index ee0926c5464..a4b2a41ff9f 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1727,10 +1727,16 @@ package body Make is Project => Arguments_Project, Path => Arguments_Path_Name); - -- If the source is not a source of a project file, - -- we simply add the saved gcc switches. + -- If the source is not a source of a project file, check if + -- this is allowed. if Arguments_Project = No_Project then + if not External_Unit_Compilation_Allowed then + Make_Failed ("external source, not part of any projects, " & + "cannot be compiled (", Source_File_Name, ")"); + end if; + + -- If it is allowed, simply add the saved gcc switches Add_Arguments (The_Saved_Gcc_Switches.all); diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb index 268f75492eb..ed7140f84d7 100644 --- a/gcc/ada/makeusg.adb +++ b/gcc/ada/makeusg.adb @@ -191,6 +191,12 @@ begin Write_Str (" -vPx Specify verbosity when parsing GNAT Project Files"); Write_Eol; + -- Line for -x + + Write_Str (" -x " & + "Allow compilation of needed units external to the projects"); + Write_Eol; + -- Line for -X Write_Str (" -Xnm=val Specify an external reference for GNAT " & diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index eb92cd76daf..926affc54c7 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -24,14 +24,14 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; -with Osint; use Osint; -with Prj; use Prj; +with Namet; use Namet; +with Osint; use Osint; +with Prj; use Prj; with Prj.Ext; with Prj.Util; -with Snames; use Snames; +with Snames; use Snames; with Table; -with Types; use Types; +with Types; use Types; with System.HTable; @@ -44,6 +44,8 @@ package body Makeutl is -- Identify either a mono-unit source (when Index = 0) or a specific unit -- in a multi-unit source. + -- There follow many global undocumented declarations, comments needed ??? + Max_Mask_Num : constant := 2048; subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1; @@ -91,9 +93,9 @@ package body Makeutl is if Last_Linker_Option = Linker_Options_Buffer'Last then declare New_Buffer : constant String_List_Access := - new String_List - (1 .. Linker_Options_Buffer'Last + - Linker_Option_Initial_Count); + new String_List + (1 .. Linker_Options_Buffer'Last + + Linker_Option_Initial_Count); begin New_Buffer (Linker_Options_Buffer'Range) := Linker_Options_Buffer.all; @@ -158,7 +160,6 @@ package body Makeutl is or else Equal_Pos >= Finish then return False; - else Prj.Ext.Add (External_Name => Argv (Start .. Equal_Pos - 1), @@ -173,8 +174,7 @@ package body Makeutl is function Is_Marked (Source_File : File_Name_Type; - Index : Int := 0) - return Boolean + Index : Int := 0) return Boolean is begin return Marks.Get (K => (File => Source_File, Index => Index)); @@ -185,21 +185,21 @@ package body Makeutl is ----------------------------- function Linker_Options_Switches - (Project : Project_Id) - return String_List + (Project : Project_Id) return String_List is + procedure Recursive_Add_Linker_Options (Proj : Project_Id); + -- The recursive routine used to add linker options ---------------------------------- -- Recursive_Add_Linker_Options -- ---------------------------------- - procedure Recursive_Add_Linker_Options (Proj : Project_Id); - procedure Recursive_Add_Linker_Options (Proj : Project_Id) is - Data : Project_Data; + Data : Project_Data; Linker_Package : Package_Id; - Options : Variable_Value; - Imported : Project_List; + Options : Variable_Value; + Imported : Project_List; + begin if Proj /= No_Project then Data := Projects.Table (Proj); @@ -239,6 +239,8 @@ package body Makeutl is end if; end Recursive_Add_Linker_Options; + -- Start of processing for Linker_Options_Switches + begin Linker_Opts.Init; @@ -382,7 +384,6 @@ package body Makeutl is is begin if Switch /= null then - declare Sw : String (1 .. Switch'Length); Start : Positive; @@ -458,6 +459,7 @@ package body Makeutl is Start : Natural; Finish : Natural; Result : Int := 0; + begin Get_Name_String (ALI_File); @@ -486,9 +488,9 @@ package body Makeutl is -- the character that precedes a unit index, this is not the ALI file -- of a unit in a multi-unit source. - if Start > Finish or else - Start = 1 or else - Name_Buffer (Start - 1) /= Multi_Unit_Index_Character + if Start > Finish + or else Start = 1 + or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character then return 0; end if; @@ -496,8 +498,8 @@ package body Makeutl is -- Build the index from the digit(s) while Start <= Finish loop - Result := (Result * 10) + Character'Pos (Name_Buffer (Start)) - - Character'Pos ('0'); + Result := Result * 10 + + Character'Pos (Name_Buffer (Start)) - Character'Pos ('0'); Start := Start + 1; end loop; diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index b5cfaf7be3d..0a3f11a0aaf 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -24,37 +24,45 @@ -- -- ------------------------------------------------------------------------------ -with GNAT.OS_Lib; use GNAT.OS_Lib; with Osint; -with Prj; use Prj; -with Types; use Types; +with Prj; use Prj; +with Types; use Types; + +with GNAT.OS_Lib; use GNAT.OS_Lib; package Makeutl is type Fail_Proc is access procedure - (S1 : String; S2 : String := ""; S3 : String := ""); + (S1 : String; + S2 : String := ""; + S3 : String := ""); Do_Fail : Fail_Proc := Osint.Fail'Access; + -- Comment required ??? function Unit_Index_Of (ALI_File : File_Name_Type) return Int; -- Find the index of a unit in a source file. Return zero if the file -- is not a multi-unit source file. function Is_External_Assignment (Argv : String) return Boolean; - -- Verify that an external assignment switch is syntactically correct. - -- Correct forms are + -- Verify that an external assignment switch is syntactically correct + -- + -- Correct forms are: + -- -- -Xname=value -- -X"name=other value" + -- -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X" -- When this function returns True, the external assignment has -- been entered by a call to Prj.Ext.Add, so that in a project -- file, External ("name") will return "value". + function Linker_Options_Switches (Project : Project_Id) return String_List; + -- Comment required ??? + -- Package Mains is used to store the mains specified on the command line -- and to retrieve them when a project file is used, to verify that the -- files exist and that they belong to a project file. - function Linker_Options_Switches (Project : Project_Id) return String_List; - package Mains is -- Mains are stored in a table. An index is used to retrieve the mains @@ -100,8 +108,7 @@ package Makeutl is function Is_Marked (Source_File : File_Name_Type; - Index : Int := 0) - return Boolean; + Index : Int := 0) return Boolean; -- Returns True if the unit was previously marked. procedure Delete_All_Marks; diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index f40d2728367..dca2b0fe9f2 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -320,6 +320,9 @@ gnat_init_options (unsigned int argc, const char **argv) save_argc = argc; save_argv = argv; + /* Uninitialized really means uninitialized in Ada. */ + flag_zero_initialized_in_bss = 0; + return CL_Ada; } @@ -972,4 +975,3 @@ fp_size_to_prec (int size) abort (); } - diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index 7c3a4ee707f..152d272b035 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2003, Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2004, Ada Core Technologies, 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- -- @@ -64,7 +64,6 @@ package body MLib.Utl is Success : Boolean; Line_Length : Natural := 0; - Max_Line_Length : constant := 200; -- arbitrary begin Initialize; @@ -82,9 +81,12 @@ package body MLib.Utl is Line_Length := Ar_Name'Length; for J in Arguments'Range loop + -- Make sure the Output buffer does not overflow - if Line_Length + 1 + Arguments (J)'Length > Max_Line_Length then + if Line_Length + 1 + Arguments (J)'Length > + Integer (Opt.Max_Line_Length) + then Write_Eol; Line_Length := 0; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 90babc28861..eb34e50f3fc 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -398,6 +398,11 @@ package Opt is -- effect if an explicit Link_Name is supplied (a link name is always -- used exactly as given). + External_Unit_Compilation_Allowed : Boolean := False; + -- GNATMAKE + -- When True (set by gnatmake switch -x), allow compilation of sources + -- that are not part of any project file. + Float_Format : Character := ' '; -- GNAT -- A non-blank value indicates that a Float_Format pragma has been @@ -659,6 +664,15 @@ package Opt is -- extension, as set by the appropriate switch. If no switch is given, -- then this value is initialized by Osint to the appropriate value. + Max_Line_Length : Int := Hostparm.Max_Line_Length; + -- This is a copy of Max_Line_Length used by the scanner. It is usually + -- set to be a copy of Hostparm.Max_Line_Length, and is used to check + -- the maximum line length in the scanner when style checking is inactive. + -- The only time it is set to a different value is during the scanning of + -- configuration pragma files, where we want to turn off all checking and + -- in particular we want to allow long lines. So we reset this value to + -- Column_Number'Last during scanning of configuration pragma files. + Maximum_Processes : Positive := 1; -- GNATMAKE -- Maximum number of processes that should be spawned to carry out diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 0e83dbb7d06..aa45a7a03b4 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1029,7 +1029,6 @@ package body Osint is if Command_Name (Cindex2) in '0' .. '9' then for J in reverse Cindex1 .. Cindex2 loop - if Command_Name (J) = '.' or Command_Name (J) = ';' then Cindex2 := J - 1; exit; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index f6e69c74814..6e5672d1aca 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -93,10 +93,14 @@ package Osint is -- gives the total number of filenames found on the command line. No_Index : constant := -1; + -- Value used in Add_File to indicate that no index is specified + -- for a main. procedure Add_File (File_Name : String; Index : Int := No_Index); -- Called by the subprogram processing the command line for each - -- file name found. + -- file name found. The index, when not defaulted to No_Index + -- is the index of the subprogram in its source, zero indicating + -- that the source is not multi-unit. procedure Find_Program_Name; -- Put simple name of current program being run (excluding the directory diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 89233fa90eb..0db8d9150bd 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -197,8 +197,8 @@ package body Prj.Dect is -- Set, if appropriate the index case insensitivity flag elsif Attributes.Table (Current_Attribute).Kind_2 in - Case_Insensitive_Associative_Array .. - Optional_Index_Case_Insensitive_Associative_Array + Case_Insensitive_Associative_Array .. + Optional_Index_Case_Insensitive_Associative_Array then Set_Case_Insensitive (Attribute, To => True); end if; @@ -257,15 +257,16 @@ package body Prj.Dect is Expect (Tok_Integer_Literal, "integer literal"); if Token = Tok_Integer_Literal then + + -- Set the source index value from given literal + declare Index : constant Int := UI_To_Int (Int_Literal_Value); begin if Index = 0 then Error_Msg ("index cannot be zero", Token_Ptr); - else - -- Set the index Set_Source_Index_Of (Attribute, To => Index); end if; end; diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index 8dade507915..cc1bd83db80 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -1205,6 +1205,8 @@ package body Prj.Strt is Scan; + -- Check for possible index expression + if Token = Tok_At then if not Optional_Index then Error_Msg ("index not allowed here", Token_Ptr); @@ -1214,6 +1216,8 @@ package body Prj.Strt is Scan; end if; + -- Set the index value + else Scan; Expect (Tok_Integer_Literal, "integer literal"); @@ -1224,9 +1228,7 @@ package body Prj.Strt is begin if Index = 0 then Error_Msg ("index cannot be zero", Token_Ptr); - else - -- Set the index Set_Source_Index_Of (Term_Id, To => Index); end if; end; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 993d1ecf451..2a67b57c5b1 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -2361,8 +2361,8 @@ package body Prj.Tree is (Project_Nodes.Table (Node).Kind = N_Variable_Reference or else Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration) - and then - Project_Nodes.Table (To).Kind = N_String_Type_Declaration); + and then + Project_Nodes.Table (To).Kind = N_String_Type_Declaration); if Project_Nodes.Table (Node).Kind = N_Variable_Reference then Project_Nodes.Table (Node).Field3 := To; @@ -2400,9 +2400,9 @@ package body Prj.Tree is pragma Assert (Node /= Empty_Node and then - (Project_Nodes.Table (Node).Kind = N_Literal_String - or else - Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); + (Project_Nodes.Table (Node).Kind = N_Literal_String + or else + Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); return Project_Nodes.Table (Node).Src_Index; end Source_Index_Of; @@ -2410,9 +2410,7 @@ package body Prj.Tree is -- String_Type_Of -- -------------------- - function String_Type_Of - (Node : Project_Node_Id) return Project_Node_Id - is + function String_Type_Of (Node : Project_Node_Id) return Project_Node_Id is begin pragma Assert (Node /= Empty_Node diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads index c517ae5ee30..2d34ff111c9 100644 --- a/gcc/ada/s-auxdec.ads +++ b/gcc/ada/s-auxdec.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-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- -- @@ -42,6 +42,16 @@ with Unchecked_Conversion; package System.Aux_DEC is pragma Elaborate_Body (Aux_DEC); + subtype Short_Address is Address; + -- In some versions of System.Aux_DEC, notably that for VMS on the + -- ia64, there are two address types (64-bit and 32-bit), and the + -- name Short_Address is used for the short address form. To avoid + -- difficulties (in regression tests and elsewhere) with units that + -- reference Short_Address, it is provided for other targets as a + -- synonum for the normal Address type, and, as in the case where + -- the lengths are different, Address and Short_Address can be + -- freely inter-converted. + type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; for Integer_8'Size use 8; diff --git a/gcc/ada/s-inmaop.ads b/gcc/ada/s-inmaop.ads index d83f12184af..2bb8ef0caa1 100644 --- a/gcc/ada/s-inmaop.ads +++ b/gcc/ada/s-inmaop.ads @@ -7,7 +7,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-1998, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -35,78 +35,82 @@ package System.Interrupt_Management.Operations is procedure Thread_Block_Interrupt (Interrupt : Interrupt_ID); - -- Mask the calling thread for the interrupt pragma Inline (Thread_Block_Interrupt); + -- Mask the calling thread for the interrupt procedure Thread_Unblock_Interrupt (Interrupt : Interrupt_ID); - -- Unmask the calling thread for the interrupt pragma Inline (Thread_Unblock_Interrupt); + -- Unmask the calling thread for the interrupt procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask); -- Set the interrupt mask of the calling thread + procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask; OMask : access Interrupt_Mask); + pragma Inline (Set_Interrupt_Mask); -- Set the interrupt mask of the calling thread while returning the -- previous Mask. - pragma Inline (Set_Interrupt_Mask); procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask); - -- Get the interrupt mask of the calling thread pragma Inline (Get_Interrupt_Mask); + -- Get the interrupt mask of the calling thread function Interrupt_Wait (Mask : access Interrupt_Mask) return Interrupt_ID; - -- Wait for the interrupts specified in Mask and return - -- the interrupt received. Upon error it return 0. pragma Inline (Interrupt_Wait); + -- Wait for the interrupts specified in Mask and return + -- the interrupt received. Return 0 upon error. procedure Install_Default_Action (Interrupt : Interrupt_ID); - -- Set the sigaction of the Interrupt to default (SIG_DFL). pragma Inline (Install_Default_Action); + -- Set the sigaction of the Interrupt to default (SIG_DFL). procedure Install_Ignore_Action (Interrupt : Interrupt_ID); - -- Set the sigaction of the Interrupt to ignore (SIG_IGN). pragma Inline (Install_Ignore_Action); + -- Set the sigaction of the Interrupt to ignore (SIG_IGN). procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask); - -- Get a Interrupt_Mask with all the interrupt masked pragma Inline (Fill_Interrupt_Mask); + -- Get a Interrupt_Mask with all the interrupt masked procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask); - -- Get a Interrupt_Mask with all the interrupt unmasked pragma Inline (Empty_Interrupt_Mask); + -- Get a Interrupt_Mask with all the interrupt unmasked procedure Add_To_Interrupt_Mask (Mask : access Interrupt_Mask; Interrupt : Interrupt_ID); - -- Mask the given interrupt in the Interrupt_Mask pragma Inline (Add_To_Interrupt_Mask); + -- Mask the given interrupt in the Interrupt_Mask procedure Delete_From_Interrupt_Mask (Mask : access Interrupt_Mask; Interrupt : Interrupt_ID); - -- Unmask the given interrupt in the Interrupt_Mask pragma Inline (Delete_From_Interrupt_Mask); + -- Unmask the given interrupt in the Interrupt_Mask function Is_Member (Mask : access Interrupt_Mask; Interrupt : Interrupt_ID) return Boolean; - -- See if a given interrupt is masked in the Interrupt_Mask pragma Inline (Is_Member); + -- See if a given interrupt is masked in the Interrupt_Mask procedure Copy_Interrupt_Mask (X : out Interrupt_Mask; Y : Interrupt_Mask); - -- Assigment needed for limited private type Interrupt_Mask. pragma Inline (Copy_Interrupt_Mask); + -- Assigment needed for limited private type Interrupt_Mask. procedure Interrupt_Self_Process (Interrupt : Interrupt_ID); - -- raise an Interrupt process-level pragma Inline (Interrupt_Self_Process); + -- Raise an Interrupt process-level -- The following objects serve as constants, but are initialized -- in the body to aid portability. These actually belong to the -- System.Interrupt_Management but since Interrupt_Mask is a -- private type we can not have them declared there. + -- Why not make these deferred constants that are initialized using + -- function calls in the private part??? + Environment_Mask : aliased Interrupt_Mask; -- This mask represents the mask of Environment task when this package -- is being elaborated, except the signals being diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 0398551d5dd..5e8fbbf2298 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -26,7 +26,6 @@ with Atree; use Atree; with Csets; use Csets; -with Hostparm; with Namet; use Namet; with Opt; use Opt; with Scans; use Scans; @@ -99,13 +98,11 @@ package body Scn is procedure Check_End_Of_Line is Len : constant Int := Int (Scan_Ptr) - Int (Current_Line_Start); - begin - if Len > Hostparm.Max_Line_Length then - Error_Long_Line; - - elsif Style_Check then + if Style_Check then Style.Check_Line_Terminator (Len); + elsif Len > Opt.Max_Line_Length then + Error_Long_Line; end if; end Check_End_Of_Line; @@ -115,6 +112,7 @@ package body Scn is function Determine_License return License_Type is GPL_Found : Boolean := False; + Result : License_Type; function Contains (S : String) return Boolean; -- See if current comment contains successive non-blank characters @@ -191,14 +189,17 @@ package body Scn is or else Source (Scan_Ptr + 1) /= '-' then if GPL_Found then - return GPL; + Result := GPL; + exit; else - return Unknown; + Result := Unknown; + exit; end if; elsif Contains ("Asaspecialexception") then if GPL_Found then - return Modified_GPL; + Result := Modified_GPL; + exit; end if; elsif Contains ("GNUGeneralPublicLicense") then @@ -211,7 +212,8 @@ package body Scn is Contains ("ThisspecificationisderivedfromtheAdaReferenceManual") then - return Unrestricted; + Result := Unrestricted; + exit; end if; Skip_EOL; @@ -240,6 +242,8 @@ package body Scn is end; end if; end loop; + + return Result; end Determine_License; ---------------------------- @@ -259,7 +263,7 @@ package body Scn is begin Error_Msg ("this line is too long", - Current_Line_Start + Hostparm.Max_Line_Length); + Current_Line_Start + Source_Ptr (Opt.Max_Line_Length)); end Error_Long_Line; ------------------------ diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 93e340f54ac..92b3c74810d 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -26,7 +26,6 @@ with Csets; use Csets; with Err_Vars; use Err_Vars; -with Hostparm; use Hostparm; with Namet; use Namet; with Opt; use Opt; with Scans; use Scans; @@ -302,7 +301,14 @@ package body Scng is if Style_Check and Style_Check_Max_Line_Length then Style.Check_Line_Terminator (Len); - elsif Len > Hostparm.Max_Line_Length then + -- If style checking is inactive, check maximum line length against + -- standard value. Note that we take this from Opt.Max_Line_Length + -- rather than Hostparm.Max_Line_Length because we do not want to + -- impose any limit during scanning of configuration pragma files, + -- and Opt.Max_Line_Length (normally set to Hostparm.Max_Line_Length) + -- is reset to Column_Number'Max during scanning of such files. + + elsif Len > Opt.Max_Line_Length then Error_Long_Line; end if; end Check_End_Of_Line; @@ -359,7 +365,7 @@ package body Scng is begin Error_Msg ("this line is too long", - Current_Line_Start + Hostparm.Max_Line_Length); + Current_Line_Start + Source_Ptr (Opt.Max_Line_Length)); end Error_Long_Line; ------------------------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index c821c7c2fc0..9c0da7f97f7 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -511,7 +511,7 @@ package body Sem_Ch10 is end; end if; - -- Generate distribution stub files if requested and no error + -- Generate distribution stubs if requested and no error if N = Main_Cunit and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body @@ -546,9 +546,6 @@ package body Sem_Ch10 is Add_Stub_Constructs (N); end if; - -- Reanalyze the unit with the new constructs - - Analyze (Unit_Node); end if; if Nkind (Unit_Node) = N_Package_Declaration diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 954d4d343cb..4f9383142e5 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4359,17 +4359,19 @@ package body Sem_Ch4 is -- subprograms are used to hide its operators, they will be -- truly hidden. - procedure Remove_Address_Interpretations; + type Operand_Position is (First_Op, Second_Op); + + procedure Remove_Address_Interpretations (Op : Operand_Position); -- Ambiguities may arise when the operands are literal and the -- address operations in s-auxdec are visible. In that case, remove -- the interpretation of a literal as Address, to retain the semantics -- of Address as a private type. ------------------------------------ - -- Remove_Address_Intereprtations -- + -- Remove_Address_Interpretations -- ------------------------------------ - procedure Remove_Address_Interpretations is + procedure Remove_Address_Interpretations (Op : Operand_Position) is Formal : Entity_Id; begin @@ -4378,13 +4380,11 @@ package body Sem_Ch4 is while Present (It.Nam) loop Formal := First_Entity (It.Nam); - if Is_Descendent_Of_Address (Etype (Formal)) - or else - (Present (Next_Entity (Formal)) - and then - Is_Descendent_Of_Address - (Etype (Next_Entity (Formal)))) - then + if Op = Second_Op then + Formal := Next_Entity (Formal); + end if; + + if Is_Descendent_Of_Address (Etype (Formal)) then Remove_Interp (I); end if; @@ -4417,38 +4417,43 @@ package body Sem_Ch4 is Get_Next_Interp (I, It); end loop; - -- Remove corresponding predefined operator, which is - -- always added to the overload set, unless it is a universal - -- operation. - if No (Abstract_Op) then return; - -- Remove address interpretations if we have a universal - -- interpretation. This avoids literals being interpreted - -- as type Address, which is never appropriate. - elsif Nkind (N) in N_Op then - if Nkind (N) in N_Unary_Op - and then Present (Universal_Interpretation (Right_Opnd (N))) - then - Remove_Address_Interpretations; + -- Remove interpretations that treat literals as addresses. + -- This is never appropriate. - elsif Nkind (N) in N_Binary_Op - and then Present (Universal_Interpretation (Right_Opnd (N))) - and then Present (Universal_Interpretation (Left_Opnd (N))) - then - Remove_Address_Interpretations; + if Nkind (N) in N_Binary_Op then + declare + U1 : constant Boolean := + Present (Universal_Interpretation (Right_Opnd (N))); + U2 : constant Boolean := + Present (Universal_Interpretation (Left_Opnd (N))); - else - Get_First_Interp (N, I, It); - while Present (It.Nam) loop - if Scope (It.Nam) = Standard_Standard then - Remove_Interp (I); + begin + if U1 and then not U2 then + Remove_Address_Interpretations (Second_Op); + + elsif U2 and then not U1 then + Remove_Address_Interpretations (First_Op); end if; - Get_Next_Interp (I, It); - end loop; + if not (U1 and U2) then + + -- Remove corresponding predefined operator, which is + -- always added to the overload set. + + Get_First_Interp (N, I, It); + while Present (It.Nam) loop + if Scope (It.Nam) = Standard_Standard then + Remove_Interp (I); + end if; + + Get_Next_Interp (I, It); + end loop; + end if; + end; end if; elsif Nkind (N) = N_Function_Call @@ -4459,18 +4464,24 @@ package body Sem_Ch4 is and then Nkind (Selector_Name (Name (N))) = N_Operator_Symbol)) then + declare Arg1 : constant Node_Id := First (Parameter_Associations (N)); + U1 : constant Boolean := + Present (Universal_Interpretation (Arg1)); + U2 : constant Boolean := + Present (Next (Arg1)) and then + Present (Universal_Interpretation (Next (Arg1))); begin - if Present (Universal_Interpretation (Arg1)) - and then - (No (Next (Arg1)) - or else Present (Universal_Interpretation (Next (Arg1)))) - then - Remove_Address_Interpretations; + if U1 and then not U2 then + Remove_Address_Interpretations (First_Op); - else + elsif U2 and then not U1 then + Remove_Address_Interpretations (Second_Op); + end if; + + if not (U1 and U2) then Get_First_Interp (N, I, It); while Present (It.Nam) loop if Scope (It.Nam) = Standard_Standard @@ -4486,7 +4497,7 @@ package body Sem_Ch4 is end if; -- If the removal has left no valid interpretations, emit - -- error message now an label node as illegal. + -- error message now and label node as illegal. if Present (Abstract_Op) then Get_First_Interp (N, I, It); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3d4f02eef6f..89512b51c7e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4599,8 +4599,9 @@ package body Sem_Ch6 is end if; -- In any case the implicit operation remains hidden by - -- the existing declaration. + -- the existing declaration, which is overriding. + Set_Is_Overriding_Operation (E); return; -- Within an instance, the renaming declarations for diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 4c538b0ff40..5c85af2d600 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.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- -- @@ -41,6 +41,7 @@ with Sem_Ch6; use Sem_Ch6; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; with Snames; use Snames; +with Stand; use Stand; with Sinfo; use Sinfo; with Uintp; use Uintp; @@ -423,6 +424,27 @@ package body Sem_Disp is Has_Dispatching_Parent : Boolean := False; Body_Is_Last_Primitive : Boolean := False; + function Is_Visibly_Controlled (T : Entity_Id) return Boolean; + -- Check whether T is derived from a visibly controlled type. + -- This is true if the root type is declared in Ada.Finalization. + -- If T is derived instead from a private type whose full view + -- is controlled, an explicit Initialize/Adjust/Finalize subprogram + -- does not override the inherited one. + + --------------------------- + -- Is_Visibly_Controlled -- + --------------------------- + + function Is_Visibly_Controlled (T : Entity_Id) return Boolean is + Root : constant Entity_Id := Root_Type (T); + begin + return Chars (Scope (Root)) = Name_Finalization + and then Chars (Scope (Scope (Root))) = Name_Ada + and then Scope (Scope (Scope (Root))) = Standard_Standard; + end Is_Visibly_Controlled; + + -- Start of processing for Check_Dispatching_Operation + begin if Ekind (Subp) /= E_Procedure and then Ekind (Subp) /= E_Function then return; @@ -595,8 +617,19 @@ package body Sem_Disp is if Present (Old_Subp) then Check_Subtype_Conformant (Subp, Old_Subp); - Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp); - Set_Is_Overriding_Operation (Subp); + if (Chars (Subp) = Name_Initialize + or else Chars (Subp) = Name_Adjust + or else Chars (Subp) = Name_Finalize) + and then Is_Controlled (Tagged_Type) + and then not Is_Visibly_Controlled (Tagged_Type) + then + Set_Is_Overriding_Operation (Subp, False); + Error_Msg_NE + ("operation does not override inherited&?", Subp, Subp); + else + Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp); + Set_Is_Overriding_Operation (Subp); + end if; else Add_Dispatching_Operation (Tagged_Type, Subp); end if; diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 9f138ebf7ce..cb07a921c87 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -24,19 +24,21 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Einfo; use Einfo; -with Errout; use Errout; -with Namet; use Namet; -with Nlists; use Nlists; -with Sinput; use Sinput; -with Sinfo; use Sinfo; -with Snames; use Snames; -with Stand; use Stand; -with Stringt; use Stringt; +with Atree; use Atree; +with Einfo; use Einfo; +with Errout; use Errout; +with Namet; use Namet; +with Nlists; use Nlists; +with Sem_Prag; use Sem_Prag; +with Sinput; use Sinput; +with Sinfo; use Sinfo; +with Snames; use Snames; +with Stand; use Stand; +with Stringt; use Stringt; with Table; with GNAT.HTable; use GNAT.HTable; + package body Sem_Elim is No_Elimination : Boolean; @@ -774,15 +776,11 @@ package body Sem_Elim is Data.Entity_Scope (1) := Chars (Arg_Ent); - elsif Nkind (Arg_Entity) = N_String_Literal then - String_To_Name_Buffer (Strval (Arg_Entity)); + elsif Is_Config_Static_String (Arg_Entity) then Data.Entity_Name := Name_Find; Data.Entity_Node := Arg_Entity; else - Error_Msg_N - ("wrong form for Entity_Argument parameter of pragma%", - Arg_Unit_Name); return; end if; else @@ -794,12 +792,33 @@ package body Sem_Elim is if Present (Arg_Parameter_Types) then - -- Case of one name, which looks like a parenthesized literal - -- rather than an aggregate. + -- Here for aggregate case - if Nkind (Arg_Parameter_Types) = N_String_Literal - and then Paren_Count (Arg_Parameter_Types) = 1 - then + if Nkind (Arg_Parameter_Types) = N_Aggregate then + Data.Parameter_Types := + new Names + (1 .. List_Length (Expressions (Arg_Parameter_Types))); + + Lit := First (Expressions (Arg_Parameter_Types)); + for J in Data.Parameter_Types'Range loop + if Is_Config_Static_String (Lit) then + Data.Parameter_Types (J) := Name_Find; + Next (Lit); + else + return; + end if; + end loop; + + -- Otherwise we must have case of one name, which looks like a + -- parenthesized literal rather than an aggregate. + + elsif Paren_Count (Arg_Parameter_Types) /= 1 then + Error_Msg_N + ("wrong form for argument of pragma Eliminate", + Arg_Parameter_Types); + return; + + elsif Is_Config_Static_String (Arg_Parameter_Types) then String_To_Name_Buffer (Strval (Arg_Parameter_Types)); if Name_Len = 0 then @@ -812,53 +831,21 @@ package body Sem_Elim is Data.Parameter_Types := new Names'(1 => Name_Find); end if; - -- Otherwise must be an aggregate - - elsif Nkind (Arg_Parameter_Types) /= N_Aggregate - or else Present (Component_Associations (Arg_Parameter_Types)) - or else No (Expressions (Arg_Parameter_Types)) - then - Error_Msg_N - ("Parameter_Types for pragma% must be list of string literals", - Arg_Parameter_Types); - return; - - -- Here for aggregate case - else - Data.Parameter_Types := - new Names - (1 .. List_Length (Expressions (Arg_Parameter_Types))); - - Lit := First (Expressions (Arg_Parameter_Types)); - for J in Data.Parameter_Types'Range loop - if Nkind (Lit) /= N_String_Literal then - Error_Msg_N - ("parameter types for pragma% must be string literals", - Lit); - return; - end if; - - String_To_Name_Buffer (Strval (Lit)); - Data.Parameter_Types (J) := Name_Find; - Next (Lit); - end loop; + return; end if; end if; -- Process Result_Types argument if Present (Arg_Result_Type) then - - if Nkind (Arg_Result_Type) /= N_String_Literal then - Error_Msg_N - ("Result_Type argument for pragma% must be string literal", - Arg_Result_Type); + if Is_Config_Static_String (Arg_Result_Type) then + Data.Result_Type := Name_Find; + else return; end if; - String_To_Name_Buffer (Strval (Arg_Result_Type)); - Data.Result_Type := Name_Find; + -- Here if no Result_Types argument else Data.Result_Type := No_Name; @@ -867,17 +854,11 @@ package body Sem_Elim is -- Process Source_Location argument if Present (Arg_Source_Location) then - - if Nkind (Arg_Source_Location) /= N_String_Literal then - Error_Msg_N - ("Source_Location argument for pragma% must be string literal", - Arg_Source_Location); + if Is_Config_Static_String (Arg_Source_Location) then + Data.Source_Location := Name_Find; + else return; end if; - - String_To_Name_Buffer (Strval (Arg_Source_Location)); - Data.Source_Location := Name_Find; - else Data.Source_Location := No_Name; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b7c3cafa0b5..5ab5bdeed45 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9916,7 +9916,6 @@ package body Sem_Prag is when Unknown_Pragma => raise Program_Error; - end case; exception @@ -9948,7 +9947,7 @@ package body Sem_Prag is and then (Is_Generic_Instance (Result) or else Nkind (Parent (Declaration_Node (Result))) = - N_Subprogram_Renaming_Declaration) + N_Subprogram_Renaming_Declaration) and then Present (Alias (Result)) loop Result := Alias (Result); @@ -9957,6 +9956,65 @@ package body Sem_Prag is return Result; end Get_Base_Subprogram; + ----------------------------- + -- Is_Config_Static_String -- + ----------------------------- + + function Is_Config_Static_String (Arg : Node_Id) return Boolean is + + function Add_Config_Static_String (Arg : Node_Id) return Boolean; + -- This is an internal recursive function that is just like the + -- outer function except that it adds the string to the name buffer + -- rather than placing the string in the name buffer. + + ------------------------------ + -- Add_Config_Static_String -- + ------------------------------ + + function Add_Config_Static_String (Arg : Node_Id) return Boolean is + N : Node_Id; + C : Char_Code; + + begin + N := Arg; + + if Nkind (N) = N_Op_Concat then + if Add_Config_Static_String (Left_Opnd (N)) then + N := Right_Opnd (N); + else + return False; + end if; + end if; + + if Nkind (N) /= N_String_Literal then + Error_Msg_N ("string literal expected for pragma argument", N); + return False; + + else + for J in 1 .. String_Length (Strval (N)) loop + C := Get_String_Char (Strval (N), J); + + if not In_Character_Range (C) then + Error_Msg + ("string literal contains invalid wide character", + Sloc (N) + 1 + Source_Ptr (J)); + return False; + end if; + + Add_Char_To_Name_Buffer (Get_Character (C)); + end loop; + end if; + + return True; + end Add_Config_Static_String; + + -- Start of prorcessing for Is_Config_Static_String + + begin + Name_Len := 0; + return Add_Config_Static_String (Arg); + end Is_Config_Static_String; + ----------------------------------------- -- Is_Non_Significant_Pragma_Reference -- ----------------------------------------- diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 9ff4ede80a2..fe5cd93320a 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -59,6 +59,17 @@ package Sem_Prag is -- False is returned, then the argument is treated as an entity reference -- to the operator. + function Is_Config_Static_String (Arg : Node_Id) return Boolean; + -- This is called for a configuration pragma that requires either a + -- string literal or a concatenation of string literals. We cannot + -- use normal static string processing because it is too early in + -- the case of the pragma appearing in a configuration pragmas file. + -- If Arg is of an appropriate form, then this call obtains the string + -- (doing any necessary concatenations) and places it in Name_Buffer, + -- setting Name_Len to its length, and then returns True. If it is + -- not of the correct form, then an appropriate error message is + -- posted, and False is returned. + procedure Process_Compilation_Unit_Pragmas (N : Node_Id); -- Called at the start of processing compilation unit N to deal with -- any special issues regarding pragmas. In particular, we have to diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index db85ab27c95..263e701e11d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -136,9 +136,10 @@ package body Sem_Util is Rtyp := Typ; end if; - if No (Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn)) - or else not Rep - then + Discard_Node ( + Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn)); + + if not Rep then return; end if; @@ -3309,9 +3310,21 @@ package body Sem_Util is P_Aliased := True; end if; + -- A discriminant check on a selected component may be + -- expanded into a dereference when removing side-effects. + -- Recover the original node and its type, which may be + -- unconstrained. + + elsif Nkind (P) = N_Explicit_Dereference + and then not (Comes_From_Source (P)) + then + P := Original_Node (P); + Prefix_Type := Etype (P); + else -- Check for prefix being an aliased component ??? null; + end if; if Is_Access_Type (Prefix_Type) diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 67cee510139..5215fe15029 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -672,6 +672,12 @@ package body Switch.M is Ptr := Ptr + 1; Verbose_Mode := True; + -- Processing for x switch + + when 'x' => + Ptr := Ptr + 1; + External_Unit_Compilation_Allowed := True; + -- Processing for z switch when 'z' => diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 01be1603930..4213e8a3a15 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -1348,7 +1348,6 @@ create_var_decl (tree var_name, || (static_flag && ! init_const))) assign_init = var_init, var_init = 0; - DECL_COMMON (var_decl) = !flag_no_common; DECL_INITIAL (var_decl) = var_init; TREE_READONLY (var_decl) = const_flag; DECL_EXTERNAL (var_decl) = extern_flag; @@ -1621,7 +1620,6 @@ process_attributes (tree decl, struct attrib *attr_list) DECL_SECTION_NAME (decl) = build_string (IDENTIFIER_LENGTH (attr_list->name), IDENTIFIER_POINTER (attr_list->name)); - DECL_COMMON (decl) = 0; } else post_error ("?section attributes are not supported for this target", diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 256d8a64a51..ca621b033b6 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -3839,6 +3839,14 @@ package VMS_Data is -- will execute the elaboration routines of the package and its closure, -- then the finalization routines. + S_Make_Nonpro : aliased constant S := "/NON_PROJECT_UNIT_COMPILATION " & + "-x"; + -- /NON_PROJECT_UNIT_COMPILATION + -- + -- Normally, when using project files, a unit that is not part of any + -- project file, cannot be compile. These units may be compile, when + -- needed, if this qualifier is specified. + S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES " & "-nostdinc"; -- /NOSTD_INCLUDES @@ -3988,6 +3996,7 @@ package VMS_Data is S_Make_Minimal 'Access, S_Make_Nolink 'Access, S_Make_Nomain 'Access, + S_Make_Nonpro 'Access, S_Make_Nostinc 'Access, S_Make_Nostlib 'Access, S_Make_Object 'Access, |
