This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
committed: Ada updates
- From: Arnaud Charlet <charlet at ACT-Europe dot FR>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 12 Feb 2004 14:28:58 +0100
- Subject: committed: Ada updates
Tested on x86-linux
--
2004-02-12 Olivier Hainque <hainque@act-europe.fr>
* decl.c (components_to_record): Don't claim that the internal fields
we make to hold the variant parts are semantically addressable, because
they are not.
* exp_pakd.adb (Create_Packed_Array_Type): Rename Esiz into PASize and
adjust the comment describing the modular type form when we can use it.
(Install_PAT): Account for the Esiz renaming.
* init.c (__gnat_error_handler for alpha-tru64): Arrange to clear the
sc_onstack context indication before raising the exception to which
the signal is mapped. Allows better handling of later signals possibly
triggered by the resumed user code if the exception is handled.
2004-02-12 Arnaud Charlet <charlet@act-europe.fr>
* 5zinit.adb: Removed, no longer used.
2004-02-12 Robert Dewar <dewar@gnat.com>
* ali.adb: Remove separating space between parameters on R line. Makes
format consistent with format used by the binder for Set_Globals call.
* atree.ads, atree.adb: Minor reformatting (new function header format)
* bindgen.adb: Add Run-Time Globals documentation section containing
detailed documentation of the globals passed from the binder file to
the run time.
* gnatls.adb: Minor reformatting
* init.c (__gnat_set_globals): Add note pointing to documentation in
bindgen.
* lib-writ.ads, lib-writ.adb: Remove separating space between
parameters on R line.
Makes format consistent with format used by the binder for Set_Globals
call.
* osint.ads: Add 2004 to copyright notice
Minor reformatting
* snames.ads: Correct capitalization of FIFO_Within_Priorities
Noticed during code reading, documentation issue only
* usage.adb: Remove junk line for obsolete C switch
Noticed during code reading
2004-02-12 Vincent Celier <celier@gnat.com>
* bld.adb (Process_Declarative_Items): For Source_Dirs call gprcmd
extend for each directory, so that multiple /** directories are
extended individually.
(Recursive_Process): Set the default for LANGUAGES to ada
* gprcmd.adb: Define new command "ignore", to do nothing.
Implement new comment "path".
* Makefile.generic: Suppress output when SILENT is set
Make sure that when compiler for C/C++ is gcc, the correct -x switch is
used, so that the correct compiler is invoked.
When compiler is gcc/g++, put search path in env vars C_INCLUDE_PATH/
CXX_INCLUDE_PATH, to avoid failure with too long command lines.
2004-02-12 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in: Clean ups and remove obsolete targets.
2004-02-12 Ed Schonberg <schonberg@gnat.com>
* exp_ch5.adb: Remove Possible_Unligned_Slice, in favor of the similar
predicate declared in exp_util.
* exp_util.adb: Add comments.
* sem_ch10.adb (Analyze_Subunit): Remove ultimate parent unit from
visibility before compiling context of the subunit.
* sem_res.adb (Check_Parameterless_Call): If the context expects a
value but the name is a procedure, do not attempt to analyze as a call,
in order to obtain more telling diagnostics.
* sem_util.adb (Wrong_Type): Further enhancement to diagnose missing
'Access on parameterless function calls.
(Normalize_Actuals): For a parameterless function call with missing
actuals, defer diagnostic until resolution of enclosing call.
* sem_util.adb (Wrong_Type): If the context type is an access to
subprogram and the expression is a procedure name, suggest a missing
'attribute.
--
Index: ali.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/ali.adb,v
retrieving revision 1.15
diff -u -p -r1.15 ali.adb
--- ali.adb 9 Feb 2004 14:56:03 -0000 1.15
+++ ali.adb 12 Feb 2004 13:26:31 -0000
@@ -991,10 +991,6 @@ package body ALI is
end case;
end loop;
- -- Skip separating space
-
- Checkc (' ');
-
-- Acquire information for parameter restrictions
for RP in All_Parameter_Restrictions loop
Index: atree.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/atree.adb,v
retrieving revision 1.11
diff -u -p -r1.11 atree.adb
--- atree.adb 2 Feb 2004 12:31:47 -0000 1.11
+++ atree.adb 12 Feb 2004 13:26:31 -0000
@@ -1032,8 +1032,7 @@ package body Atree is
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
- New_Scope : Entity_Id := Empty)
- return Node_Id
+ New_Scope : Entity_Id := Empty) return Node_Id
is
Actual_Map : Elist_Id := Map;
-- This is the actual map for the copy. It is initialized with the
@@ -1053,8 +1052,7 @@ package body Atree is
-- Builds hash tables (number of elements >= threshold value)
function Copy_Elist_With_Replacement
- (Old_Elist : Elist_Id)
- return Elist_Id;
+ (Old_Elist : Elist_Id) return Elist_Id;
-- Called during second phase to copy element list doing replacements.
procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
@@ -1167,8 +1165,7 @@ package body Atree is
---------------------------------
function Copy_Elist_With_Replacement
- (Old_Elist : Elist_Id)
- return Elist_Id
+ (Old_Elist : Elist_Id) return Elist_Id
is
M : Elmt_Id;
New_Elist : Elist_Id;
@@ -1243,8 +1240,7 @@ package body Atree is
--------------------------------
function Copy_List_With_Replacement
- (Old_List : List_Id)
- return List_Id
+ (Old_List : List_Id) return List_Id
is
New_List : List_Id;
E : Node_Id;
@@ -1270,14 +1266,12 @@ package body Atree is
--------------------------------
function Copy_Node_With_Replacement
- (Old_Node : Node_Id)
- return Node_Id
+ (Old_Node : Node_Id) return Node_Id
is
New_Node : Node_Id;
function Copy_Field_With_Replacement
- (Field : Union_Id)
- return Union_Id;
+ (Field : Union_Id) return Union_Id;
-- Given Field, which is a field of Old_Node, return a copy of it
-- if it is a syntactic field (i.e. its parent is Node), setting
-- the parent of the copy to poit to New_Node. Otherwise returns
@@ -1288,8 +1282,7 @@ package body Atree is
---------------------------------
function Copy_Field_With_Replacement
- (Field : Union_Id)
- return Union_Id
+ (Field : Union_Id) return Union_Id
is
begin
if Field = Union_Id (Empty) then
@@ -1829,8 +1822,7 @@ package body Atree is
function New_Entity
(New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr)
- return Entity_Id
+ New_Sloc : Source_Ptr) return Entity_Id
is
Ent : Entity_Id;
@@ -1900,8 +1892,7 @@ package body Atree is
function New_Node
(New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr)
- return Node_Id
+ New_Sloc : Source_Ptr) return Node_Id
is
Nod : Node_Id;
Index: atree.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/atree.ads,v
retrieving revision 1.7
diff -u -p -r1.7 atree.ads
--- atree.ads 2 Feb 2004 12:31:47 -0000 1.7
+++ atree.ads 12 Feb 2004 13:26:31 -0000
@@ -332,8 +332,7 @@ package Atree is
function New_Node
(New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr)
- return Node_Id;
+ New_Sloc : Source_Ptr) return Node_Id;
-- Allocates a completely new node with the given node type and source
-- location values. All other fields are set to their standard defaults:
--
@@ -351,8 +350,7 @@ package Atree is
function New_Entity
(New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr)
- return Entity_Id;
+ New_Sloc : Source_Ptr) return Entity_Id;
-- Similar to New_Node, except that it is used only for entity nodes
-- and returns an extended node.
@@ -427,8 +425,7 @@ package Atree is
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
- New_Scope : Entity_Id := Empty)
- return Node_Id;
+ New_Scope : Entity_Id := Empty) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
-- syntactic subtree, including recursively any descendents whose parent
-- field references a copied node (descendents not linked to a copied node
Index: bindgen.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bindgen.adb,v
retrieving revision 1.20
diff -u -p -r1.20 bindgen.adb
--- bindgen.adb 4 Feb 2004 11:06:18 -0000 1.20
+++ bindgen.adb 12 Feb 2004 13:26:32 -0000
@@ -80,6 +80,88 @@ package body Bindgen is
Table_Increment => 200,
Table_Name => "IS_Pragma_Settings");
+ ----------------------
+ -- Run-Time Globals --
+ ----------------------
+
+ -- This section documents the global variables that are passed to the
+ -- run time from the generated binder file. The call that is made is
+ -- to the routine Set_Globals, which has the following spec:
+
+ -- procedure Set_Globals
+ -- (Main_Priority : Integer;
+ -- Time_Slice_Value : Integer;
+ -- WC_Encoding : Character;
+ -- Locking_Policy : Character;
+ -- Queuing_Policy : Character;
+ -- Task_Dispatching_Policy : Character;
+ -- Restrictions : System.Address;
+ -- Interrupt_States : System.Address;
+ -- Num_Interrupt_States : Integer;
+ -- Unreserve_All_Interrupts : Integer;
+ -- Exception_Tracebacks : Integer;
+ -- Zero_Cost_Exceptions : Integer);
+
+ -- Main_Priority is the priority value set by pragma Priority in the
+ -- main program. If no such pragma is present, the value is -1.
+
+ -- Time_Slice_Value is the time slice value set by pragma Time_Slice
+ -- in the main program, or by the use of a -Tnnn parameter for the
+ -- binder (if both are present, the binder value overrides). The
+ -- value is in milliseconds. A value of zero indicates that time
+ -- slicing should be suppressed. If no pragma is present, and no
+ -- -T switch was used, the value is -1.
+
+ -- WC_Encoding shows the wide character encoding method used for
+ -- the main program. This is one of the encoding letters defined
+ -- in System.WCh_Con.WC_Encoding_Letters.
+
+ -- Locking_Policy is a space if no locking policy was specified
+ -- for the partition. If a locking policy was specified, the value
+ -- is the upper case first character of the locking policy name,
+ -- for example, 'C' for Ceiling_Locking.
+
+ -- Queuing_Policy is a space if no queuing policy was specified
+ -- for the partition. If a queuing policy was specified, the value
+ -- is the upper case first character of the queuing policy name
+ -- for example, 'F' for FIFO_Queuing.
+
+ -- Task_Dispatching_Policy is a space if no task dispatching policy
+ -- was specified for the partition. If a task dispatching policy
+ -- was specified, the value is the upper case first character of
+ -- the policy name, e.g. 'F' for FIFO_Within_Priorities.
+
+ -- Restrictions is the address of a null-terminated string specifying the
+ -- restrictions information for the partition. The format is identical to
+ -- that of the parameter string found on R lines in ali files (see Lib.Writ
+ -- spec in lib-writ.ads for full details). The difference is that in this
+ -- context the values are the cumulative ones for the entire partition.
+
+ -- Interrupt_States is the address of a string used to specify the
+ -- cumulative results of Interrupt_State pragmas used in the partition.
+ -- The length of this string is determined by the last interrupt for which
+ -- such a pragma is given (the string will be a null string if no pragmas
+ -- were used). If pragma were present the entries apply to the interrupts
+ -- in sequence from the first interrupt, and are set to one of four
+ -- possible settings: 'n' for not specified, 'u' for user, 'r' for
+ -- run time, 's' for system, see description of Interrupt_State pragma
+ -- for further details.
+
+ -- Num_Interrupt_States is the length of the Interrupt_States string.
+ -- It will be set to zero if no Interrupt_State pragmas are present.
+
+ -- Unreserve_All_Interrupts is set to one if at least one unit in the
+ -- partition had a pragma Unreserve_All_Interrupts, and zero otherwise.
+
+ -- Exception_Tracebacks is set to one if the -E parameter was present
+ -- in the bind and to zero otherwise. Note that on some targets exception
+ -- tracebacks are provided by default, so a value of zero for this
+ -- parameter does not necessarily mean no trace backs are available.
+
+ -- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
+ -- this partition, and to zero if longjmp/setjmp exceptions are used.
+ -- the use of zero
+
-----------------------
-- Local Subprograms --
-----------------------
Index: bld.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bld.adb,v
retrieving revision 1.7
diff -u -p -r1.7 bld.adb
--- bld.adb 4 Feb 2004 11:06:18 -0000 1.7
+++ bld.adb 12 Feb 2004 13:26:32 -0000
@@ -1504,11 +1504,11 @@ package body Bld is
-- being an absolute directory name.
Put (Project_Name &
- ".src_dirs:=$(shell gprcmd extend $(");
- Put (Project_Name);
- Put (".base_dir) '$(");
+ ".src_dirs:=$(foreach name,$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
- Put_Line (")')");
+ Put ("),$(shell gprcmd extend $(");
+ Put (Project_Name);
+ Put_Line (".base_dir) '$(name)'))");
elsif Item_Name = Snames.Name_Source_Files then
@@ -2691,6 +2691,13 @@ package body Bld is
IO.Mark (Src_List_File_Init);
Put_Line ("src_list_file.specified:=FALSE");
+
+ -- Default language is Ada, but variable LANGUAGES may have
+ -- been changed by an imported Makefile. So, we set it
+ -- to "ada"; if attribute Languages is defined in the project
+ -- file, it will be redefined.
+
+ Put_Line ("LANGUAGES:=ada");
-- <PROJECT>.src_dirs is set by default to the project
-- directory.
Index: decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/decl.c,v
retrieving revision 1.27
diff -u -p -r1.27 decl.c
--- decl.c 2 Feb 2004 12:31:48 -0000 1.27
+++ decl.c 12 Feb 2004 13:26:32 -0000
@@ -5366,7 +5366,7 @@ components_to_record (tree gnu_record_ty
? TYPE_SIZE (gnu_record_type) : 0),
(all_rep_and_size
? bitsize_zero_node : 0),
- 1);
+ 0);
DECL_INTERNAL_P (gnu_field) = 1;
DECL_QUALIFIER (gnu_field) = gnu_qual;
@@ -5397,7 +5397,7 @@ components_to_record (tree gnu_record_ty
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
packed,
all_rep ? TYPE_SIZE (gnu_union_type) : 0,
- all_rep ? bitsize_zero_node : 0, 1);
+ all_rep ? bitsize_zero_node : 0, 0);
DECL_INTERNAL_P (gnu_union_field) = 1;
TREE_CHAIN (gnu_union_field) = gnu_field_list;
Index: exp_ch5.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch5.adb,v
retrieving revision 1.15
diff -u -p -r1.15 exp_ch5.adb
--- exp_ch5.adb 2 Feb 2004 12:31:50 -0000 1.15
+++ exp_ch5.adb 12 Feb 2004 13:26:32 -0000
@@ -52,7 +52,6 @@ with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
-with Ttypes; use Ttypes;
with Uintp; use Uintp;
with Validsw; use Validsw;
@@ -181,16 +180,6 @@ package body Exp_Ch5 is
-- an object. Such objects can be aliased to parameters (unlike local
-- array references).
- function Possible_Unaligned_Slice (Arg : Node_Id) return Boolean;
- -- Returns True if Arg (either the left or right hand side of the
- -- assignment) is a slice that could be unaligned wrt the array type.
- -- This is true if Arg is a component of a packed record, or is
- -- a record component to which a component clause applies. This
- -- is a little pessimistic, but the result of an unnecessary
- -- decision that something is possibly unaligned is only to
- -- generate a front end loop, which is not so terrible.
- -- It would really be better if backend handled this ???
-
-----------------------
-- Apply_Dereference --
-----------------------
@@ -242,60 +231,6 @@ package body Exp_Ch5 is
and then Is_Non_Local_Array (Prefix (Exp)));
end Is_Non_Local_Array;
- ------------------------------
- -- Possible_Unaligned_Slice --
- ------------------------------
-
- function Possible_Unaligned_Slice (Arg : Node_Id) return Boolean is
- begin
- -- No issue if this is not a slice, or else strict alignment
- -- is not required in any case.
-
- if Nkind (Arg) /= N_Slice
- or else not Target_Strict_Alignment
- then
- return False;
- end if;
-
- -- No issue if the component type is a byte or byte aligned
-
- declare
- Array_Typ : constant Entity_Id := Etype (Arg);
- Comp_Typ : constant Entity_Id := Component_Type (Array_Typ);
- Pref : constant Node_Id := Prefix (Arg);
-
- begin
- if Known_Alignment (Array_Typ) then
- if Alignment (Array_Typ) = 1 then
- return False;
- end if;
-
- elsif Known_Component_Size (Array_Typ) then
- if Component_Size (Array_Typ) = 1 then
- return False;
- end if;
-
- elsif Known_Esize (Comp_Typ) then
- if Esize (Comp_Typ) <= System_Storage_Unit then
- return False;
- end if;
- end if;
-
- -- No issue if this is not a selected component
-
- if Nkind (Pref) /= N_Selected_Component then
- return False;
- end if;
-
- -- Else we test for a possibly unaligned component
-
- return
- Is_Packed (Etype (Pref))
- or else
- Present (Component_Clause (Entity (Selector_Name (Pref))));
- end;
- end Possible_Unaligned_Slice;
-
-- Determine if Lhs, Rhs are formal arrays or nonlocal arrays
Lhs_Formal : constant Boolean := Is_Formal_Array (Act_Lhs);
@@ -528,8 +463,8 @@ package body Exp_Ch5 is
elsif Is_Bit_Packed_Array (L_Type)
or else Is_Bit_Packed_Array (R_Type)
- or else Possible_Unaligned_Slice (Lhs)
- or else Possible_Unaligned_Slice (Rhs)
+ or else Is_Possibly_Unaligned_Slice (Lhs)
+ or else Is_Possibly_Unaligned_Slice (Rhs)
then
Loop_Required := True;
Index: exp_pakd.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_pakd.adb,v
retrieving revision 1.10
diff -u -p -r1.10 exp_pakd.adb
--- exp_pakd.adb 23 Jan 2004 10:30:03 -0000 1.10
+++ exp_pakd.adb 12 Feb 2004 13:26:32 -0000
@@ -700,7 +700,7 @@ package body Exp_Pakd is
Ancest : Entity_Id;
PB_Type : Entity_Id;
- Esiz : Uint;
+ PASize : Uint;
Decl : Node_Id;
PAT : Entity_Id;
Len_Dim : Node_Id;
@@ -770,10 +770,10 @@ package body Exp_Pakd is
-- Do not reset RM_Size if already set, as happens in the case
-- of a modular type.
- Set_Esize (PAT, Esiz);
+ Set_Esize (PAT, PASize);
if Unknown_RM_Size (PAT) then
- Set_RM_Size (PAT, Esiz);
+ Set_RM_Size (PAT, PASize);
end if;
-- Set remaining fields of packed array type
@@ -853,7 +853,7 @@ package body Exp_Pakd is
-- type, since this size clearly belongs to the packed array type. The
-- size of the conceptual unpacked type is always set to unknown.
- Esiz := Esize (Typ);
+ PASize := Esize (Typ);
-- Case of an array where at least one index is of an enumeration
-- type with a non-standard representation, but the component size
@@ -1099,7 +1099,8 @@ package body Exp_Pakd is
-- We can use the modular type, it has the form:
-- subtype tttPn is btyp
- -- range 0 .. 2 ** (Esize (Typ) * Csize) - 1;
+ -- range 0 .. 2 ** ((Typ'Length (1)
+ -- * ... * Typ'Length (n)) * Csize) - 1;
-- The bounds are statically known, and btyp is one
-- of the unsigned types, depending on the length. If the
@@ -1140,8 +1141,8 @@ package body Exp_Pakd is
Make_Integer_Literal (Loc, 0),
High_Bound => Lit))));
- if Esiz = Uint_0 then
- Esiz := Len_Bits;
+ if PASize = Uint_0 then
+ PASize := Len_Bits;
end if;
Install_PAT;
Index: exp_util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_util.adb,v
retrieving revision 1.19
diff -u -p -r1.19 exp_util.adb
--- exp_util.adb 2 Feb 2004 12:31:51 -0000 1.19
+++ exp_util.adb 12 Feb 2004 13:26:32 -0000
@@ -2352,6 +2352,13 @@ package body Exp_Util is
function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
begin
+ -- ??? GCC3 will eventually handle strings with arbitrary alignments,
+ -- but for now the following check must be disabled.
+
+ -- if get_gcc_version >= 3 then
+ -- return False;
+ -- end if;
+
if Is_Entity_Name (P)
and then Is_Object (Entity (P))
and then Present (Renamed_Object (Entity (P)))
Index: gnatls.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatls.adb,v
retrieving revision 1.13
diff -u -p -r1.13 gnatls.adb
--- gnatls.adb 9 Feb 2004 14:56:04 -0000 1.13
+++ gnatls.adb 12 Feb 2004 13:26:32 -0000
@@ -87,10 +87,10 @@ procedure Gnatls is
Print_Unit : Boolean := True;
Print_Source : Boolean := True;
Print_Object : Boolean := True;
- -- Flags controlling the form of the outpout
+ -- Flags controlling the form of the output
- Dependable : Boolean := False; -- flag -d
- Also_Predef : Boolean := False;
+ Dependable : Boolean := False; -- flag -d
+ Also_Predef : Boolean := False;
Unit_Start : Integer;
Unit_End : Integer;
@@ -132,14 +132,14 @@ procedure Gnatls is
-- updated to the full file name if available.
function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
- -- Give the Sdep entry corresponding to the unit U in ali record A.
+ -- Give the Sdep entry corresponding to the unit U in ali record A
procedure Output_Object (O : File_Name_Type);
-- Print out the name of the object when requested
procedure Output_Source (Sdep_I : Sdep_Id);
-- Print out the name and status of the source corresponding to this
- -- sdep entry
+ -- sdep entry.
procedure Output_Status (FS : File_Status; Verbose : Boolean);
-- Print out FS either in a coded form if verbose is false or in an
@@ -152,10 +152,10 @@ procedure Gnatls is
-- Reset Print flags properly when selective output is chosen
procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
- -- Scan and process lser specific arguments. Argv is a single argument.
+ -- Scan and process lser specific arguments. Argv is a single argument
procedure Usage;
- -- Print usage message.
+ -- Print usage message
-----------------
-- Add_Lib_Dir --
@@ -279,10 +279,12 @@ procedure Gnatls is
-- Verify is output is not wider than maximum number of columns
- Too_Long := Verbose_Mode or else
- (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
+ Too_Long :=
+ Verbose_Mode
+ or else
+ (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
- -- Set start and end of columns.
+ -- Set start and end of columns
Object_Start := 1;
Object_End := Object_Start - 1;
@@ -817,10 +819,9 @@ begin
Namet.Initialize;
Csets.Initialize;
- -- Use low level argument routines to avoid dragging in the secondary stack
+ -- Loop to scan out arguments
Next_Arg := 1;
-
Scan_Args : while Next_Arg < Arg_Count loop
declare
Next_Argv : String (1 .. Len_Arg (Next_Arg));
@@ -956,6 +957,7 @@ begin
end loop;
Find_General_Layout;
+
for Id in ALIs.First .. ALIs.Last loop
declare
Last_U : Unit_Id;
@@ -993,7 +995,7 @@ begin
end if;
end loop;
- -- Print out list of dependable units
+ -- Print out list of units on which this unit depends (D lines)
if Dependable and then Print_Source then
if Verbose_Mode then
Index: gprcmd.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gprcmd.adb,v
retrieving revision 1.7
diff -u -p -r1.7 gprcmd.adb
--- gprcmd.adb 4 Feb 2004 11:06:18 -0000 1.7
+++ gprcmd.adb 12 Feb 2004 13:26:32 -0000
@@ -38,6 +38,9 @@
-- deps post process dependency makefiles
-- stamp copy file time stamp from file1 to file2
-- prefix get the prefix of the GNAT installation
+-- path convert a list of directories to a path list, inserting a
+-- path separator after each directory, including the last one
+-- ignore do nothing
with Gnatvsn;
with Osint; use Osint;
@@ -349,6 +352,10 @@ procedure Gprcmd is
"copy file time stamp from file1 to file2");
Put_Line (Standard_Error, " prefix " &
"get the prefix of the GNAT installation");
+ Put_Line (Standard_Error, " path " &
+ "convert a directory list into a path list");
+ Put_Line (Standard_Error, " ignore " &
+ "do nothing");
OS_Exit (1);
end Usage;
@@ -363,7 +370,8 @@ begin
begin
if Cmd = "-v" then
- -- Should this be on Standard_Error ???
+ -- Output on standard error, because only returned values should
+ -- go to standard output.
Put (Standard_Error, "GPRCMD ");
Put (Standard_Error, Gnatvsn.Gnat_Version_String);
@@ -473,6 +481,19 @@ begin
end if;
end if;
end;
+
+ -- For "path" just add path separator after each directory argument
+
+ elsif Cmd = "path" then
+ for J in 2 .. Argument_Count loop
+ Put (Argument (J));
+ Put (Path_Separator);
+ end loop;
+
+ -- For "ignore" do nothing
+
+ elsif Cmd = "ignore" then
+ null;
-- Unknown command
Index: init.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/init.c,v
retrieving revision 1.23
diff -u -p -r1.23 init.c
--- init.c 2 Feb 2004 12:31:53 -0000 1.23
+++ init.c 12 Feb 2004 13:26:32 -0000
@@ -39,6 +39,10 @@
installed by this file are used to handle resulting signals that come
from these probes failing (i.e. touching protected pages) */
+/* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
+ 5zinit.adb. All these files implement the required functionality for
+ different targets. */
+
/* The following include is here to meet the published VxWorks requirement
that the __vxworks header appear before any other include. */
#ifdef __vxworks
@@ -154,6 +158,9 @@ __gnat_get_interrupt_state (int intrup)
binder file is not in the shared library. Global references across library
boundaries like this are not handled correctly in all systems. */
+/* For detailed description of the parameters to this routine, see the
+ section titled Run-Time Globals in package Bindgen (bindgen.adb) */
+
void
__gnat_set_globals (int main_priority,
int time_slice_val,
@@ -363,6 +370,7 @@ __gnat_initialize (void)
exclude this case in the above test. */
#include <signal.h>
+#include <setjmp.h>
#include <sys/siginfo.h>
static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
@@ -440,7 +448,48 @@ __gnat_error_handler (int sig, siginfo_t
if (mstate != 0)
*mstate = *context;
- Raise_From_Signal_Handler (exception, (char *) msg);
+ /* We are now going to raise the exception corresponding to the signal we
+ caught, which may eventually end up resuming the application code if the
+ exception is handled.
+
+ When the exception is handled, merely arranging for the *exception*
+ handler's context (stack pointer, program counter, other registers, ...)
+ to be installed is *not* enough to let the kernel think we've left the
+ *signal* handler. This has annoying implications if an alternate stack
+ has been setup for this *signal* handler, because the kernel thinks we
+ are still running on that alternate stack even after the jump, which
+ causes trouble at least as soon as another signal is raised.
+
+ We deal with this by forcing a "local" longjmp within the signal handler
+ below, forcing the "on alternate stack" indication to be reset (kernel
+ wise) on the way. If no alternate stack has been setup, this should be a
+ neutral operation. Otherwise, we will be in a delicate situation for a
+ short while because we are going to run the exception propagation code
+ within the alternate stack area (that is, with the stack pointer inside
+ the alternate stack bounds), but with the corresponding flag off from the
+ kernel's standpoint. We expect this to be ok as long as the propagation
+ code does not trigger a signal itself, which is expected.
+
+ ??? A better approach would be to at least delay this operation until the
+ last second, that is, until just before we jump to the exception handler,
+ if any. */
+ {
+ jmp_buf handler_jmpbuf;
+
+ if (setjmp (handler_jmpbuf) != 0)
+ Raise_From_Signal_Handler (exception, (char *) msg);
+ else
+ {
+ /* Arrange for the "on alternate stack" flag to be reset. See the
+ comments around "jmp_buf offsets" in /usr/include/setjmp.h. */
+ struct sigcontext * handler_context
+ = (struct sigcontext *) & handler_jmpbuf;
+
+ handler_context->sc_onstack = 0;
+
+ longjmp (handler_jmpbuf, 1);
+ }
+ }
}
void
@@ -461,11 +510,12 @@ __gnat_install_handler (void)
we want this to happen for tasks also. */
static char sig_stack [8*1024];
- /* 8K allocated here because 4K is not enough for the GCC/ZCX scheme. */
+ /* 8K is a mininum to be able to propagate an exception using the GCC/ZCX
+ scheme. */
struct sigaltstack ss;
- ss.ss_sp = (void *) & sig_stack;
+ ss.ss_sp = (void *) sig_stack;
ss.ss_size = sizeof (sig_stack);
ss.ss_flags = 0;
Index: lib-writ.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib-writ.adb,v
retrieving revision 1.15
diff -u -p -r1.15 lib-writ.adb
--- lib-writ.adb 9 Feb 2004 14:56:04 -0000 1.15
+++ lib-writ.adb 12 Feb 2004 13:26:32 -0000
@@ -940,10 +940,6 @@ package body Lib.Writ is
end if;
end loop;
- -- A separating space
-
- Write_Info_Char (' ');
-
-- And now the information for the parameter restrictions
for RP in All_Parameter_Restrictions loop
Index: lib-writ.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib-writ.ads,v
retrieving revision 1.12
diff -u -p -r1.12 lib-writ.ads
--- lib-writ.ads 9 Feb 2004 14:56:04 -0000 1.12
+++ lib-writ.ads 12 Feb 2004 13:26:32 -0000
@@ -256,7 +256,7 @@ package Lib.Writ is
-- has been able to determine with respect to restrictions violations.
-- The format is:
- -- R <<restriction-characters>> space <<restriction-param-id-entries>>
+ -- R <<restriction-characters>> <<restriction-param-id-entries>>
-- The first parameter is a string of characters that records
-- information regarding restrictions that do not take parameter
@@ -283,8 +283,9 @@ package Lib.Writ is
-- has "v", which is not permitted, since these restrictions
-- are partition-wide.
- -- Following a space, the second parameter refers to restriction
- -- identifiers for which a parameter is given.
+ -- The second parameter, which immediately follows the first (with
+ -- no separating space) gives restriction information for identifiers
+ -- for which a parameter is given.
-- The parameter is a string of entries, one for each value in
-- Restrict.All_Parameter_Restrictions. Each entry has two
Index: Makefile.generic
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.generic,v
retrieving revision 1.6
diff -u -p -r1.6 Makefile.generic
--- Makefile.generic 26 Jan 2004 14:47:48 -0000 1.6
+++ Makefile.generic 12 Feb 2004 13:26:32 -0000
@@ -9,12 +9,12 @@
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
-
+
# GCC is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
-
+
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
@@ -64,7 +64,7 @@
# CXX name of the C++ compiler (optional, default to gcc)
# AR_CMD command to create an archive (optional, default to "ar rc")
# AR_EXT file extension of an archive (optional, default to ".a")
-# RANLIB command to generate an index (optional, default to "ranlib")
+# RANLIB command to generate an index (optional, default to "ranlib")
# GNATMAKE name of the GNAT builder (optional, default to "gnatmake")
# ADAFLAGS additional Ada compilation switches, e.g "-gnatf" (optional)
# CFLAGS default C compilation switches, e.g "-O2 -g" (optional)
@@ -78,6 +78,9 @@
# PROJECT_FILE name of the project file, without the .gpr extension
# DEPS_PROJECTS list of project dependencies (optional)
+# SILENT (optional) when defined, make -s will not output anything
+# when all commands are successful.
+
# Set the source search path for C and C++ if needed
ifndef MAIN
@@ -124,7 +127,7 @@ ifndef RANLIB
endif
ifndef GNATMAKE
- GNATMAKE=gnatmake
+ GNATMAKE:=gnatmake
endif
ifndef ARCHIVE
@@ -135,6 +138,39 @@ ifeq ($(EXEC_DIR),)
EXEC_DIR=$(OBJ_DIR)
endif
+# Define display to echo only when SILENT is not defined
+
+ifdef SILENT
+define display
+ @gprcmd ignore
+endef
+
+else
+define display
+ @echo
+endef
+endif
+
+# Make sure gnatmake is called silently when SILENT is set
+ifdef SILENT
+ GNATMAKE:=$(GNATMAKE) -q
+endif
+
+# If C/C++ compiler is gcc, make sure gcc is called with the switch indicating
+# the language, in case the extension is not standard.
+
+ifeq ($(strip $(filter-out %gcc,$(CC))),)
+ C_Compiler=$(CC) -x c
+else
+ C_Compiler=$(CC)
+endif
+
+ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
+ CXX_Compiler=$(CXX) -x c++
+else
+ CXX_Compiler=$(CXX)
+endif
+
# Set the object search path
vpath %$(OBJ_EXT) $(OBJ_DIR)
@@ -222,8 +258,8 @@ else
endif
C_INCLUDES := $(foreach name,$(SRC_DIRS),-I$(name))
-ALL_CFLAGS = $(CFLAGS) $(C_INCLUDES) $(DEP_CFLAGS)
-ALL_CXXFLAGS = $(CXXFLAGS) $(C_INCLUDES) $(DEP_CFLAGS)
+ALL_CFLAGS = $(CFLAGS) $(DEP_CFLAGS)
+ALL_CXXFLAGS = $(CXXFLAGS) $(DEP_CFLAGS)
LDFLAGS := $(LIBS) $(LDFLAGS)
# Compute list of objects based on languages
@@ -276,7 +312,7 @@ else
internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
lib$(PROJECT_BASE)$(AR_EXT): $(OBJECTS)
- @echo creating archive file for $(PROJECT_BASE)
+ @$(display) creating archive file for $(PROJECT_BASE)
cd $(OBJ_DIR); $(AR_CMD) $@ $(strip $(OBJECTS))
-$(RANLIB) $(OBJ_DIR)/$@
@@ -313,7 +349,7 @@ else
link: $(EXEC_DIR)/$(EXEC) archive-objects
$(EXEC_DIR)/$(EXEC): $(OBJ_FILES)
- @echo $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
+ @$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
endif
endif
@@ -327,11 +363,12 @@ ifeq ($(strip $(filter-out c c++ ada,$(L
ifeq ($(MAIN),ada)
# Ada main
link: $(LINKER) archive-objects force
- $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
+ @(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
+ @$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
- @echo $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
+ @$(display) $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) -P$(PROJECT_FILE) $(EXEC_RULE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(LARGS) $(LDFLAGS)
@@ -339,11 +376,12 @@ else
# C/C++ main
link: $(LINKER) archive-objects force
- $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
+ @(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
+ @$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
- @echo $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
+ @$(display) $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) \
-B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
@@ -360,7 +398,12 @@ endif
# Automatic handling of dependencies
ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
-# Compiler is GCC, take avantage of the preprocessor option -MD
+# Compiler is GCC, take avantage of the preprocessor option -MD and
+# C*_INCLUDE_PATH environment variables
+
+export C_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(C_INCLUDE_PATH)
+export CXX_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(CXX_INCLUDE_PATH)
+
DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
define post-compile
@@ -375,6 +418,9 @@ $(OBJ_DIR)/%.d:
else
# Compiler unknown, use a more general approach based on the output of $(CC) -M
+ALL_CFLAGS := $(ALL_CFLAGS) $(C_INCLUDES)
+ALL_CXXFLAGS := $(ALL_CXXFLAGS) $(C_INCLUDES)
+
DEP_FLAGS = -M
DEP_CFLAGS =
@@ -400,17 +446,17 @@ endif
# Compile C files individually
%$(OBJ_EXT) : %$(C_EXT)
- @echo $(CC) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
+ @$(display) $(C_Compiler) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
- @$(CC) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
+ @$(C_Compiler) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif
# Compile C++ files individually
%$(OBJ_EXT) : %$(CXX_EXT)
- @echo $(CXX) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
+ @$(display) $(CXX_Compiler) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
- @$(CXX) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
+ @$(CXX_Compiler) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif
Index: Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.71
diff -u -p -r1.71 Makefile.in
--- Makefile.in 2 Feb 2004 16:26:37 -0000 1.71
+++ Makefile.in 12 Feb 2004 13:26:33 -0000
@@ -1861,27 +1861,18 @@ rts-zfp: force
RTS_NAME=zfp RTS_SRCS="$(HIE_SOURCES)" \
RTS_TARGET_PAIRS="$(HIE_NONE_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_HIE_SOURCES)"
- -$(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
+ $(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
cd rts-zfp/adalib/ ; $(AR) r libgnat.a *.o
$(RM) rts-zfp/adalib/*.o
$(CHMOD) a-wx rts-zfp/adalib/*.ali
$(CHMOD) a-wx rts-zfp/adalib/libgnat.a
-rts-none: force
- $(MAKE) $(FLAGS_TO_PASS) prepare-rts \
- RTS_NAME=none RTS_SRCS="$(HIE_SOURCES)" \
- RTS_TARGET_PAIRS="$(HIE_NONE_TARGET_PAIRS)" \
- COMPILABLE_SOURCES="$(COMPILABLE_HIE_SOURCES)"
- -$(GNATMAKE) -Prts-none/none.gpr --GCC="../../../xgcc -B../../../"
- $(RM) rts-none/adalib/*.o
- $(CHMOD) a-wx rts-none/adalib/*.ali
-
rts-ravenscar: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=ravenscar RTS_SRCS="$(RAVEN_SOURCES)" \
RTS_TARGET_PAIRS="$(HIE_RAVEN_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_RAVEN_SOURCES)"
- -$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
+ $(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
--GCC="../../../xgcc -B../../../"
cd rts-ravenscar/adalib/ ; $(AR) r libgnat.a *.o
$(RM) rts-ravenscar/adalib/*.o
Index: osint.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/osint.ads,v
retrieving revision 1.11
diff -u -p -r1.11 osint.ads
--- osint.ads 5 Jan 2004 15:20:45 -0000 1.11
+++ osint.ads 12 Feb 2004 13:26:33 -0000
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- 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- --
@@ -52,9 +52,8 @@ package Osint is
type File_Type is (Source, Library, Config, Definition, Preprocessing_Data);
function Find_File
- (N : File_Name_Type;
- T : File_Type)
- return File_Name_Type;
+ (N : File_Name_Type;
+ T : File_Type) return File_Name_Type;
-- Finds a source, library or config file depending on the value
-- of T following the directory search order rules unless N is the
-- name of the file just read with Next_Main_File and already
@@ -155,8 +154,7 @@ package Osint is
function To_Canonical_File_List
(Wildcard_Host_File : String;
- Only_Dirs : Boolean)
- return String_Access_List_Access;
+ Only_Dirs : Boolean) return String_Access_List_Access;
-- Expand a wildcard host syntax file or directory specification (e.g. on
-- a VMS host, any file or directory spec that contains:
-- "*", or "%", or "...")
@@ -165,8 +163,7 @@ package Osint is
function To_Canonical_Dir_Spec
(Host_Dir : String;
- Prefix_Style : Boolean)
- return String_Access;
+ Prefix_Style : Boolean) return String_Access;
-- Convert a host syntax directory specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
-- If Prefix_Style then make it a valid file specification prefix.
@@ -176,30 +173,26 @@ package Osint is
-- this simply means the spec has a trailing slash ("/").
function To_Canonical_File_Spec
- (Host_File : String)
- return String_Access;
+ (Host_File : String) return String_Access;
-- Convert a host syntax file specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g.
-- "/sys$device/dir/file.ext.69").
function To_Canonical_Path_Spec
- (Host_Path : String)
- return String_Access;
+ (Host_Path : String) return String_Access;
-- Convert a host syntax Path specification (e.g. on a VMS host:
-- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g.
-- "/sys$device/foo:disk$user/foo").
function To_Host_Dir_Spec
(Canonical_Dir : String;
- Prefix_Style : Boolean)
- return String_Access;
+ Prefix_Style : Boolean) return String_Access;
-- Convert a canonical syntax directory specification to host syntax.
-- The Prefix_Style flag is currently ignored but should be set to
-- False.
function To_Host_File_Spec
- (Canonical_File : String)
- return String_Access;
+ (Canonical_File : String) return String_Access;
-- Convert a canonical syntax file specification to host syntax.
function Relocate_Path
@@ -209,9 +202,8 @@ package Osint is
-- replace the Prefix substring with the root installation directory.
-- By default, try to compute the root installation directory by looking
-- at the executable name as it was typed on the command line and, if
- -- needed, use the PATH environment variable.
- -- If the above computation fails, return Path.
- -- This function assumes that Prefix'First = Path'First
+ -- needed, use the PATH environment variable. If the above computation
+ -- fails, return Path. This function assumes Prefix'First = Path'First.
function Shared_Lib (Name : String) return String;
-- Returns the runtime shared library in the form -l<name>-<version> where
@@ -244,8 +236,7 @@ package Osint is
procedure Get_Next_Dir_In_Path_Init
(Search_Path : String_Access);
function Get_Next_Dir_In_Path
- (Search_Path : String_Access)
- return String_Access;
+ (Search_Path : String_Access) return String_Access;
-- These subprograms are used to parse out the directory names in a
-- search path specified by a Search_Path argument. The procedure
-- initializes an internal pointer to point to the initial directory
@@ -292,8 +283,7 @@ package Osint is
function Get_RTS_Search_Dir
(Search_Dir : String;
- File_Type : Search_File_Type)
- return String_Ptr;
+ File_Type : Search_File_Type) return String_Ptr;
-- This function retrieves the paths to the search (resp. lib) dirs and
-- return them. The search dir can be absolute or relative. If the search
-- dir contains Include_Search_File (resp. Object_Search_File), then this
@@ -382,9 +372,8 @@ package Osint is
-- called Source_File_Data (Cache => True). See below.
function Matching_Full_Source_Name
- (N : File_Name_Type;
- T : Time_Stamp_Type)
- return File_Name_Type;
+ (N : File_Name_Type;
+ T : Time_Stamp_Type) return File_Name_Type;
-- Same semantics than Full_Source_Name but will search on the source
-- path until a source file with time stamp matching T is found. If
-- none is found returns No_File.
@@ -440,8 +429,7 @@ package Osint is
function Read_Library_Info
(Lib_File : File_Name_Type;
- Fatal_Err : Boolean := False)
- return Text_Buffer_Ptr;
+ Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
-- Allocates a Text_Buffer of appropriate length and reads in the entire
-- source of the library information from the library information file
-- whose name is given by the parameter Name.
Index: sem_ch10.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch10.adb,v
retrieving revision 1.15
diff -u -p -r1.15 sem_ch10.adb
--- sem_ch10.adb 2 Feb 2004 12:31:56 -0000 1.15
+++ sem_ch10.adb 12 Feb 2004 13:26:33 -0000
@@ -1475,8 +1475,12 @@ package body Sem_Ch10 is
end if;
end if;
+ Set_Is_Immediately_Visible (Par_Unit, False);
+
Analyze_Subunit_Context;
+
Re_Install_Parents (Lib_Unit, Par_Unit);
+ Set_Is_Immediately_Visible (Par_Unit);
-- If the context includes a child unit of the parent of the
-- subunit, the parent will have been removed from visibility,
Index: sem_res.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_res.adb,v
retrieving revision 1.21
diff -u -p -r1.21 sem_res.adb
--- sem_res.adb 2 Feb 2004 12:31:59 -0000 1.21
+++ sem_res.adb 12 Feb 2004 13:26:33 -0000
@@ -801,6 +801,22 @@ package body Sem_Res is
Require_Entity (N);
end if;
+ -- If the context expects a value, and the name is a procedure,
+ -- this is most likely a missing 'Access. Do not try to resolve
+ -- the parameterless call, error will be caught when the outer
+ -- call is analyzed.
+
+ if Is_Entity_Name (N)
+ and then Ekind (Entity (N)) = E_Procedure
+ and then not Is_Overloaded (N)
+ and then
+ (Nkind (Parent (N)) = N_Parameter_Association
+ or else Nkind (Parent (N)) = N_Function_Call
+ or else Nkind (Parent (N)) = N_Procedure_Call_Statement)
+ then
+ return;
+ end if;
+
-- Rewrite as call if overloadable entity that is (or could be, in
-- the overloaded case) a function call. If we know for sure that
-- the entity is an enumeration literal, we do not rewrite it.
Index: sem_util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_util.adb,v
retrieving revision 1.20
diff -u -p -r1.20 sem_util.adb
--- sem_util.adb 13 Jan 2004 11:51:34 -0000 1.20
+++ sem_util.adb 12 Feb 2004 13:26:33 -0000
@@ -4881,17 +4881,28 @@ package body Sem_Util is
or else Sloc (S) = Standard_Location)
and then Is_Overloadable (S)
then
- Error_Msg_Name_1 := Chars (S);
- Error_Msg_Sloc := Sloc (S);
- Error_Msg_NE
- ("missing argument for parameter & " &
- "in call to % declared #", N, Formal);
+ if No (Actuals)
+ and then
+ (Nkind (Parent (N)) = N_Procedure_Call_Statement
+ or else
+ (Nkind (Parent (N)) = N_Function_Call
+ or else
+ Nkind (Parent (N)) = N_Parameter_Association))
+ then
+ Set_Etype (N, Etype (S));
+ else
+ Error_Msg_Name_1 := Chars (S);
+ Error_Msg_Sloc := Sloc (S);
+ Error_Msg_NE
+ ("missing argument for parameter & " &
+ "in call to % declared #", N, Formal);
+ end if;
elsif Is_Overloadable (S) then
Error_Msg_Name_1 := Chars (S);
- -- Point to type derivation that
- -- generated the operation.
+ -- Point to type derivation that generated the
+ -- operation.
Error_Msg_Sloc := Sloc (Parent (S));
@@ -6358,7 +6369,22 @@ package body Sem_Util is
or else
Ekind (Entity (Expr)) = E_Generic_Procedure)
then
- Error_Msg_N ("found procedure name instead of function!", Expr);
+ if Ekind (Expec_Type) = E_Access_Subprogram_Type then
+ Error_Msg_N
+ ("found procedure name, possibly missing Access attribute!",
+ Expr);
+ else
+ Error_Msg_N ("found procedure name instead of function!", Expr);
+ end if;
+
+ elsif Nkind (Expr) = N_Function_Call
+ and then Ekind (Expec_Type) = E_Access_Subprogram_Type
+ and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
+ and then No (Parameter_Associations (Expr))
+ then
+ Error_Msg_N
+ ("found function name, possibly missing Access attribute!",
+ Expr);
-- catch common error: a prefix or infix operator which is not
-- directly visible because the type isn't.
Index: snames.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/snames.ads,v
retrieving revision 1.18
diff -u -p -r1.18 snames.ads
--- snames.ads 9 Feb 2004 14:56:04 -0000 1.18
+++ snames.ads 12 Feb 2004 13:26:33 -0000
@@ -751,7 +751,7 @@ package Snames is
-- are added, the first character must be distinct.
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 440;
- Name_Fifo_Within_Priorities : constant Name_Id := N + 440;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 440;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 440;
-- Names of recognized checks for pragma Suppress
Index: usage.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/usage.adb,v
retrieving revision 1.14
diff -u -p -r1.14 usage.adb
--- usage.adb 9 Feb 2004 14:56:05 -0000 1.14
+++ usage.adb 12 Feb 2004 13:26:33 -0000
@@ -134,9 +134,6 @@ begin
Write_Switch_Char ("c");
Write_Line ("Check syntax and semantics only (no code generation)");
- Write_Switch_Char ("C");
- Write_Line ("Compress names in external names and debug info tables");
-
-- Line for -gnatd switch
Write_Switch_Char ("d?");