Skip to content

R
riscv-gcc-1
Commit 555360a5 by Arnaud Charlet
Options

[multiple changes] 

2004-03-02  Emmanuel Briot  <briot@act-europe.fr>

	* ali.adb (Read_Instantiation_Instance): Do not modify the
	current_file_num when reading information about instantiations, since
	this corrupts files in later references.

2004-03-02  Vincent Celier  <celier@gnat.com>

	* bcheck.adb (Check_Consistency): Get the full path of an ALI file
	before checking if it is read-only.

	* bld.adb (Recursive_Process): Concatenate <PROJECT>.src_dirs in front
	of SRC_DIRS and eliminate duplicates.

	* gprcmd.adb: Replace command "path" with command "path_sep" to return
	the path separator.
	(Usage): Document path_sep

	* Makefile.generic: For Ada and GNU C++ cases, link directly with the
	C++ compiler. No need for a script.
	Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH.
	Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function
	subst.

	* prj-env.adb (For_All_Source_Dirs): Only add source dirs in project
	where there are Ada sources.
	(Set_Ada_Paths): Only add to the include path the source dirs of project
	with Ada sources.
	(Add_To_Path): Add the Display_Values of the directories, not their
	Values.

	* prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project
	data.

	* prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value
	is not No_Name.
	(Find_Source_Dirs): Set Display_Value to a non canonicalized value, only
	Value is canonicalized.
	(Language_Independent_Check): Do not copy Value to Display_Value when
	canonicalizing Value.

	* prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased
	path to find limited with cycles.
	(Parse_Single_Project): Use canonical cased path to find the end of a
	with cycle.

2004-03-02  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit
	and not a child unit.

	* sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can
	appear in a with_clause.

	* decl.c (gnat_to_gnu_type): If entity is a generic type, which can
	only happen in type_annotate mode, do not try to elaborate it.

	* exp_util.adb (Force_Evaluation): If expression is a selected
	component on the left of an assignment, use a renaming rather than a
	temporary to remove side effects.

	* freeze.adb (Freeze_Entity): Do not freeze a global entity within an
	inlined instance body, which is analyzed before the end of the
	enclosing scope.

2004-03-02  Robert Dewar  <dewar@gnat.com>

	* par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb,
	sem_ch4.adb: Use new feature for substitution of keywords in VMS

	* errout.ads, errout.adb: Implement new circuit for substitution of
	keywords in VMS.

	* sem_case.adb (Analyze_Choices): Place message properly when case is
	a subtype reference rather than an explicit range.

	* sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting

2004-03-02  Doug Rupp  <rupp@gnat.com>

	* init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF.

2004-03-02  Thomas Quinot  <quinot@act-europe.fr>

	* s-tporft.adb: Add missing locking around call to Initialize_ATCB.

2004-03-02  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a
	BLKmode bitfield.

From-SVN: r78758
parent c24938d4
Showing with 413 additions and 161 deletions
gcc/ada/ChangeLog
2004-03-02 Emmanuel Briot <briot@act-europe.fr>
* ali.adb (Read_Instantiation_Instance): Do not modify the
current_file_num when reading information about instantiations, since
this corrupts files in later references.
2004-03-02 Vincent Celier <celier@gnat.com>
* bcheck.adb (Check_Consistency): Get the full path of an ALI file
before checking if it is read-only.
* bld.adb (Recursive_Process): Concatenate <PROJECT>.src_dirs in front
of SRC_DIRS and eliminate duplicates.
* gprcmd.adb: Replace command "path" with command "path_sep" to return
the path separator.
(Usage): Document path_sep
* Makefile.generic: For Ada and GNU C++ cases, link directly with the
C++ compiler. No need for a script.
Replace use of C*_INCLUDE_PATH env var for GCC compilers with CPATH.
Do not call gprcmd to build the C*_INCLUDE_PATHs, do it with function
subst.
* prj-env.adb (For_All_Source_Dirs): Only add source dirs in project
where there are Ada sources.
(Set_Ada_Paths): Only add to the include path the source dirs of project
with Ada sources.
(Add_To_Path): Add the Display_Values of the directories, not their
Values.
* prj-nmsc.adb (Find_Sources): Set flag Sources_Present in the project
data.
* prj-nmsc.adb (Add_ALI_For): Make sure that the element Display_Value
is not No_Name.
(Find_Source_Dirs): Set Display_Value to a non canonicalized value, only
Value is canonicalized.
(Language_Independent_Check): Do not copy Value to Display_Value when
canonicalizing Value.
* prj-part.adb (Post_Parse_Context_Clause): Compare canonical cased
path to find limited with cycles.
(Parse_Single_Project): Use canonical cased path to find the end of a
with cycle.
2004-03-02 Ed Schonberg <schonberg@gnat.com>
* sem_ch10.adb (Optional_Subunit): Verify that unit contains a subunit
and not a child unit.
* sinfo.ads, sinfo.adb: Rearrange flags so that Private_Present can
appear in a with_clause.
* decl.c (gnat_to_gnu_type): If entity is a generic type, which can
only happen in type_annotate mode, do not try to elaborate it.
* exp_util.adb (Force_Evaluation): If expression is a selected
component on the left of an assignment, use a renaming rather than a
temporary to remove side effects.
* freeze.adb (Freeze_Entity): Do not freeze a global entity within an
inlined instance body, which is analyzed before the end of the
enclosing scope.
2004-03-02 Robert Dewar <dewar@gnat.com>
* par-ch10.adb, par-ch3.adb, par-ch4.adb, scng.adb,
sem_ch4.adb: Use new feature for substitution of keywords in VMS
* errout.ads, errout.adb: Implement new circuit for substitution of
keywords in VMS.
* sem_case.adb (Analyze_Choices): Place message properly when case is
a subtype reference rather than an explicit range.
* sem_elim.adb, s-tpobop.ads, exp_ch2.adb: Minor reformatting
2004-03-02 Doug Rupp <rupp@gnat.com>
* init.c (__gnat_initialize)[VMS]: Resignal RDB-E-STREAM_EOF.
2004-03-02 Thomas Quinot <quinot@act-europe.fr>
* s-tporft.adb: Add missing locking around call to Initialize_ATCB.
2004-03-02 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* utils.c (finish_record_type): Do not set DECL_NONADDRESSABLE for a
BLKmode bitfield.
2004-02-25 Robert Dewar <dewar@gnat.com>
* 51osinte.ads, 52osinte.ads, 53osinte.ads, 54osinte.ads,
......
gcc/ada/Makefile.generic
......@@ -230,20 +230,16 @@ ifeq ($(filter c++,$(LANGUAGES)),c++)
ifeq ($(filter ada,$(LANGUAGES)),ada)
# C++ and Ada mixed
LINKER = $(OBJ_DIR)/c++linker
LARGS = --LINK=$(LINKER)
ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
# Case of GNU C++ and GNAT
$(LINKER): Makefile.$(PROJECT_BASE)
@echo \#!/bin/sh > $(LINKER)
@echo unset BINUTILS_ROOT >> $(LINKER)
@echo unset GCC_ROOT >> $(LINKER)
@echo $(CXX) $$\* >> $(LINKER)
@chmod +x $(LINKER)
# Case of GNAT and a GNU C++ compiler
$(LINKER):
else
# Case of GNAT and a non GNU C++ compiler
LINKER = $(OBJ_DIR)/c++linker
$(LINKER): Makefile.$(PROJECT_BASE)
@echo \#!/bin/sh > $(LINKER)
@echo $(CXX) $$\* $(shell gcc -print-libgcc-file-name) >> $(LINKER)
......@@ -399,10 +395,13 @@ endif
ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
# Compiler is GCC, take avantage of the preprocessor option -MD and
# C*_INCLUDE_PATH environment variables
# the CPATH environment variable
export C_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(C_INCLUDE_PATH)
export CXX_INCLUDE_PATH:=$(shell gprcmd path $(SRC_DIRS))$(CXX_INCLUDE_PATH)
empty:=
space:=$(empty) $(empty)
path_sep:=$(shell gprcmd path_sep)
SRC_DIRS_PATH:= $(subst $(space),$(path_sep),$(SRC_DIRS))
export CPATH:=$(SRC_DIRS_PATH)$(path_sep)$(CPATH)
DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
......
gcc/ada/ali.adb
......@@ -1811,6 +1811,8 @@ package body ALI is
----------------------------------
procedure Read_Instantiation_Reference is
Local_File_Num : Sdep_Id := Current_File_Num;
begin
Xref.Increment_Last;
......@@ -1824,12 +1826,12 @@ package body ALI is
if Nextc = '|' then
XR.File_Num :=
Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
Current_File_Num := XR.File_Num;
Local_File_Num := XR.File_Num;
P := P + 1;
N := Get_Nat;
else
XR.File_Num := Current_File_Num;
XR.File_Num := Local_File_Num;
end if;
XR.Line := N;
......
gcc/ada/bcheck.adb
......@@ -572,6 +572,8 @@ package body Bcheck is
Src : Source_Id;
-- Source file Id for this Sdep entry
ALI_Path_Id : Name_Id;
begin
-- First, we go through the source table to see if there are any cases
-- in which we should go after source files and compute checksums of
......@@ -655,18 +657,17 @@ package body Bcheck is
end if;
else
if Osint.Is_Readonly_Library (ALIs.Table (A).Afile) then
Error_Msg_Name_2 :=
Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
ALI_Path_Id :=
Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
if Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then
Error_Msg ("?% should be recompiled");
Error_Msg_Name_1 := Error_Msg_Name_2;
Error_Msg_Name_1 := ALI_Path_Id;
Error_Msg ("?(% is obsolete and read-only)");
else
Error_Msg ("% must be compiled");
Error_Msg_Name_1 := Error_Msg_Name_2;
Error_Msg_Name_1 := ALI_Path_Id;
Error_Msg ("(% is obsolete and read-only)");
end if;
......
gcc/ada/bld.adb
......@@ -3120,11 +3120,14 @@ package body Bld is
end if;
end if;
-- Add source dirs of this project file to variable SRC_DIRS
-- Add source dirs of this project file to variable SRC_DIRS.
-- Put them in front, and remove duplicates.
Put ("SRC_DIRS:=$(SRC_DIRS) $(");
Put ("SRC_DIRS:=$(");
Put (Uname);
Put (".src_dirs)");
Put (".src_dirs) $(filter-out $(");
Put (Uname);
Put (".src_dirs),$(SRC_DIRS))");
New_Line;
-- Set OBJ_DIR to the object directory
......
gcc/ada/decl.c
......@@ -114,6 +114,10 @@ gnat_to_gnu_type (Entity_Id gnat_entity)
{
tree gnu_decl;
/* The back end never attempts to annotate generic types */
if (Is_Generic_Type (gnat_entity) && type_annotate_only)
return void_type_node;
/* Convert the ada entity type into a GCC TYPE_DECL node. */
gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
if (TREE_CODE (gnu_decl) != TYPE_DECL)
......
gcc/ada/errout.adb
......@@ -37,6 +37,7 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Erroutc; use Erroutc;
with Fname; use Fname;
with Hostparm; use Hostparm;
with Lib; use Lib;
with Namet; use Namet;
with Opt; use Opt;
......@@ -187,6 +188,14 @@ package body Errout is
-- 'Class appended to its name (see Add_Class procedure), and is
-- otherwise unchanged.
procedure VMS_Convert;
-- This procedure has no effect if called when the host is not OpenVMS.
-- If the host is indeed OpenVMS, then the error message stored in
-- Msg_Buffer is scanned for appearences of switch names which need
-- converting to corresponding VMS qualifer names. See Gnames/Vnames
-- table in Errout spec for precise definition of the conversion that
-- is performed by this routine in OpenVMS mode.
-----------------------
-- Change_Error_Text --
-----------------------
......@@ -2258,6 +2267,8 @@ package body Errout is
Set_Msg_Char (C);
end case;
end loop;
VMS_Convert;
end Set_Msg_Text;
----------------
......@@ -2485,4 +2496,53 @@ package body Errout is
end if;
end Unwind_Internal_Type;
-----------------
-- VMS_Convert --
-----------------
procedure VMS_Convert is
P : Natural;
L : Natural;
N : Natural;
begin
if not OpenVMS then
return;
end if;
P := Msg_Buffer'First;
loop
if P >= Msglen then
return;
end if;
if Msg_Buffer (P) = '-' then
for G in Gnames'Range loop
L := Gnames (G)'Length;
-- See if we have "-ggg switch", where ggg is Gnames entry
if P + L + 7 <= Msglen
and then Msg_Buffer (P + 1 .. P + L) = Gnames (G).all
and then Msg_Buffer (P + L + 1 .. P + L + 7) = " switch"
then
-- Replace by "/vvv qualifier", where vvv is Vnames entry
N := Vnames (G)'Length;
Msg_Buffer (P + N + 11 .. Msglen + N - L + 3) :=
Msg_Buffer (P + L + 8 .. Msglen);
Msg_Buffer (P) := '/';
Msg_Buffer (P + 1 .. P + N) := Vnames (G).all;
Msg_Buffer (P + N + 1 .. P + N + 10) := " qualifier";
P := P + N + 10;
Msglen := Msglen + N - L + 3;
exit;
end if;
end loop;
end if;
P := P + 1;
end loop;
end VMS_Convert;
end Errout;
gcc/ada/errout.ads
......@@ -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- --
......@@ -276,6 +276,43 @@ package Errout is
-- to be non-serious, and does not cause Serious_Errors_Detected
-- to be incremented (so expansion is not prevented by such a msg).
----------------------------------------
-- Specialization of Messages for VMS --
----------------------------------------
-- Some messages mention gcc-style switch names. When using an OpenVMS
-- host, such switch names must be converted to their corresponding VMS
-- qualifer. The following table controls this translation. In each case
-- the original message must contain the string "-xxx switch", where xxx
-- is the Gname? entry from below, and this string will be replaced by
-- "/yyy qualifier", where yyy is the corresponding Vname? entry.
Gname1 : aliased constant String := "fno-strict-aliasing";
Vname1 : aliased constant String := "OPTIMIZE=NO_ALIASING";
Gname2 : aliased constant String := "gnatX";
Vname2 : aliased constant String := "EXTENSIONS_ALLOWED";
Gname3 : aliased constant String := "gnatW";
Vname3 : aliased constant String := "WIDE_CHARACTER_ENCODING";
Gname4 : aliased constant String := "gnatf";
Vname4 : aliased constant String := "REPORT_ERRORS=FULL";
type Cstring_Ptr is access constant String;
Gnames : array (Nat range <>) of Cstring_Ptr :=
(Gname1'Access,
Gname2'Access,
Gname3'Access,
Gname4'Access);
Vnames : array (Nat range <>) of Cstring_Ptr :=
(Vname1'Access,
Vname2'Access,
Vname3'Access,
Vname4'Access);
-----------------------------------------------------
-- Global Values Used for Error Message Insertions --
-----------------------------------------------------
......
gcc/ada/exp_ch2.adb
......@@ -695,6 +695,7 @@ package body Exp_Ch2 is
-- where rec is a selector whose Entry_Formal link points to the formal
-- For a formal of a task entity, the formal is rewritten as a local
-- renaming.
-- In addition, a formal that is marked volatile because it is aliased
-- through an address clause is rewritten as dereference as well.
......
gcc/ada/exp_util.adb
......@@ -1320,8 +1320,41 @@ package body Exp_Util is
----------------------
procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is
Component_In_Lhs : Boolean := False;
Par : Node_Id;
begin
Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True);
-- Loop to determine whether there is a component reference in
-- the left hand side if this appears on the left side of an
-- assignment statement. Needed to determine if form of result
-- must be a variable.
Par := Exp;
while Present (Par)
and then Nkind (Par) = N_Selected_Component
loop
if Nkind (Parent (Par)) = N_Assignment_Statement
and then Par = Name (Parent (Par))
then
Component_In_Lhs := True;
exit;
else
Par := Parent (Par);
end if;
end loop;
-- If the expression is a selected component, it is being evaluated
-- as part of a discriminant check. If it is part of a left-hand
-- side, this is the last use of its value and it is safe to create
-- a renaming for it, rather than a temporary. In addition, if it
-- is not an addressable field, creating a temporary may be a problem
-- for gigi, or might drop the value of the assignment. Therefore,
-- if the expression is on the lhs of an assignment, remove side
-- effects without requiring a temporary, and create a renaming.
-- (See remove_side_effects for details).
Remove_Side_Effects
(Exp, Name_Req, Variable_Ref => not Component_In_Lhs);
end Force_Evaluation;
------------------------
......
gcc/ada/freeze.adb
......@@ -1909,6 +1909,35 @@ package body Freeze is
S := Scope (S);
end loop;
end;
-- Similarly, an inlined instance body may make reference to global
-- entities, but these references cannot be the proper freezing point
-- for them, and the the absence of inlining freezing will take place
-- in their own scope. Normally instance bodies are analyzed after
-- the enclosing compilation, and everything has been frozen at the
-- proper place, but with front-end inlining an instance body is
-- compiled before the end of the enclosing scope, and as a result
-- out-of-order freezing must be prevented.
elsif Front_End_Inlining
and then In_Instance_Body
and then Present (Scope (E))
then
declare
S : Entity_Id := Scope (E);
begin
while Present (S) loop
if Is_Generic_Instance (S) then
exit;
else
S := Scope (S);
end if;
end loop;
if No (S) then
return No_List;
end if;
end;
end if;
-- Here to freeze the entity
......
gcc/ada/gprcmd.adb
......@@ -372,8 +372,8 @@ 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, " path_sep " &
"returns the path separator");
Put_Line (Standard_Error, " linkopts " &
"process attribute Linker'Linker_Options");
Put_Line (Standard_Error, " ignore " &
......@@ -530,11 +530,8 @@ begin
-- 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;
elsif Cmd = "path_sep" then
Put (Path_Separator);
-- Check the linker options for relative paths. Insert the project
-- base dir before relative paths.
......
gcc/ada/init.c
......@@ -1401,6 +1401,9 @@ __gnat_error_handler (int *sigargs, void *mechargs)
case 1381050: /* Nickerson bug #33 ??? */
return SS$_RESIGNAL;
case 20480426: /* RDB-E-STREAM_EOF */
return SS$_RESIGNAL;
case 11829410: /* Resignalled as Use_Error for CE10VRC */
return SS$_RESIGNAL;
......
gcc/ada/par-ch10.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- --
......@@ -30,7 +30,6 @@ pragma Style_Checks (All_Checks);
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Hostparm; use Hostparm;
with Uname; use Uname;
separate (Par)
......@@ -796,15 +795,8 @@ package body Ch10 is
if not Extensions_Allowed then
Error_Msg_SP ("`LIMITED WITH` is an Ada0X extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
else
Has_Limited := False;
......@@ -819,15 +811,7 @@ package body Ch10 is
if not Extensions_Allowed then
Error_Msg_SP ("`WITH TYPE` is a non-standard extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP ("\unit must be compiled with -gnatX switch");
end if;
Scan; -- past TYPE
......
gcc/ada/par-ch3.adb
......@@ -28,7 +28,6 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram body ordering check. Subprograms are in order
-- by RM section rather than alphabetical
with Hostparm; use Hostparm;
with Sinfo.CN; use Sinfo.CN;
separate (Par)
......@@ -1325,15 +1324,7 @@ package body Ch3 is
Error_Msg_SP
("generalized use of anonymous access types " &
"is an Ada 0Y extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP ("\unit must be compiled with -gnatX switch");
end if;
Acc_Node := P_Access_Definition;
......@@ -2125,15 +2116,7 @@ package body Ch3 is
Error_Msg_SP
("generalized use of anonymous access types " &
"is an Ada 0Y extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP ("\unit must be compiled with -gnatX switch");
end if;
Set_Subtype_Indication (CompDef_Node, Empty);
......@@ -2862,15 +2845,7 @@ package body Ch3 is
Error_Msg_SP
("Generalized use of anonymous access types " &
"is an Ada0X extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP ("\unit must be compiled with -gnatX switch");
end if;
Set_Subtype_Indication (CompDef_Node, Empty);
......
gcc/ada/par-ch4.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- --
......@@ -28,8 +28,6 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram body ordering check. Subprograms are in order
-- by RM section rather than alphabetical
with Hostparm; use Hostparm;
separate (Par)
package body Ch4 is
......@@ -1411,15 +1409,7 @@ package body Ch4 is
if not Extensions_Allowed then
Error_Msg_SP
("(Ada 0Y) limited aggregates are an Ada0X extension");
if OpenVMS then
Error_Msg_SP
("\unit must be compiled with " &
"'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
else
Error_Msg_SP
("\unit must be compiled with -gnatX switch");
end if;
Error_Msg_SP ("\unit must be compiled with -gnatX switch");
end if;
Set_Box_Present (Assoc_Node);
......
gcc/ada/prj-env.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
......@@ -61,25 +61,25 @@ package body Prj.Env is
-- platforms, except on VMS where the logical names are deassigned, thus
-- avoiding the pollution of the environment of the caller.
package Namings is new Table.Table (
Table_Component_Type => Naming_Data,
Table_Index_Type => Naming_Id,
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100,
Table_Name => "Prj.Env.Namings");
package Namings is new Table.Table
(Table_Component_Type => Naming_Data,
Table_Index_Type => Naming_Id,
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100,
Table_Name => "Prj.Env.Namings");
Default_Naming : constant Naming_Id := Namings.First;
Fill_Mapping_File : Boolean := True;
package Path_Files is new Table.Table (
Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 50,
Table_Name => "Prj.Env.Path_Files");
package Path_Files is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 50,
Table_Name => "Prj.Env.Path_Files");
-- Table storing all the temp path file names.
-- Used by Delete_All_Path_Files.
......@@ -322,7 +322,7 @@ package body Prj.Env is
begin
while Current /= Nil_String loop
Source_Dir := String_Elements.Table (Current);
Add_To_Path (Get_Name_String (Source_Dir.Value));
Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
Current := Source_Dir.Next;
end loop;
end Add_To_Path;
......@@ -1420,13 +1420,16 @@ package body Prj.Env is
The_String : String_Element;
begin
-- Call action with the name of every source directorie
while Current /= Nil_String loop
The_String := String_Elements.Table (Current);
Action (Get_Name_String (The_String.Value));
Current := The_String.Next;
end loop;
-- If there are Ada sources, call action with the name of every
-- source directory.
if Projects.Table (Project).Sources_Present then
while Current /= Nil_String loop
The_String := String_Elements.Table (Current);
Action (Get_Name_String (The_String.Value));
Current := The_String.Next;
end loop;
end if;
end;
-- If we are extending a project, visit it
......@@ -1866,8 +1869,11 @@ package body Prj.Env is
if Process_Source_Dirs then
-- Add to path all source directories of this project
-- if there are Ada sources.
Add_To_Path_File (Data.Source_Dirs, Source_FD);
if Projects.Table (Project).Sources_Present then
Add_To_Path_File (Data.Source_Dirs, Source_FD);
end if;
end if;
if Process_Object_Dirs then
......
gcc/ada/prj-part.adb
......@@ -759,6 +759,7 @@ package body Prj.Part is
begin
Name_Len := Normed'Length;
Name_Buffer (1 .. Name_Len) := Normed;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Canonical_Path_Name := Name_Find;
for Index in 1 .. Project_Stack.Last loop
......@@ -886,7 +887,9 @@ package body Prj.Part is
for Current in reverse 1 .. Project_Stack.Last loop
Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name;
if Error_Msg_Name_1 /= Canonical_Path_Name then
if Project_Stack.Table (Current).Canonical_Path_Name /=
Canonical_Path_Name
then
Error_Msg
("\ { which itself is imported by", Token_Ptr);
......
gcc/ada/s-tpobop.ads
......@@ -110,7 +110,10 @@ package System.Tasking.Protected_Objects.Operations is
--
-- This must be called with abortion deferred and with the corresponding
-- object locked.
-- If Unlock_Object, then Object is unlocked on return.
--
-- If Unlock_Object is set True, then Object is unlocked on return,
-- otherwise Object remains locked and the caller is responsible for
-- the required unlock.
procedure Complete_Entry_Body (Object : Entries.Protection_Entries_Access);
-- Called from within an entry body procedure, indicates that the
......
gcc/ada/s-tporft.adb
......@@ -63,11 +63,13 @@ begin
-- Finish initialization
Lock_RTS;
System.Tasking.Initialize_ATCB
(Self_Id, null, Null_Address, Null_Task,
Foreign_Task_Elaborated'Access,
System.Priority'First, Task_Info.Unspecified_Task_Info, 0, Self_Id,
Succeeded);
Unlock_RTS;
pragma Assert (Succeeded);
Self_Id.Master_of_Task := 0;
......
gcc/ada/scng.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- --
......@@ -333,15 +333,7 @@ package body Scng is
procedure Error_Illegal_Wide_Character is
begin
if OpenVMS then
Error_Msg_S
("illegal wide character, check " &
"'/'W'I'D'E'_'C'H'A'R'A'C'T'E'R'_'E'N'C'O'D'I'N'G qualifier");
else
Error_Msg_S
("illegal wide character, check -gnatW switch");
end if;
Error_Msg_S ("illegal wide character, check -gnatW switch");
Scan_Ptr := Scan_Ptr + 1;
end Error_Illegal_Wide_Character;
......
gcc/ada/sem_case.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2003 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- --
......@@ -556,6 +556,9 @@ package body Sem_Case is
is
E : Entity_Id;
Enode : Node_Id;
-- This is where we post error messages for bounds out of range
Nb_Choices : constant Nat := Choice_Table'Length;
Sort_Choice_Table : Sort_Choice_Table_Type (0 .. Nb_Choices);
......@@ -638,24 +641,55 @@ package body Sem_Case is
end if;
end if;
-- Check for bound out of range.
-- Check for low bound out of range
if Lo_Val < Bounds_Lo then
-- If the choice is an entity name, then it is a type, and
-- we want to post the message on the reference to this
-- entity. Otherwise we want to post it on the lower bound
-- of the range.
if Is_Entity_Name (Choice) then
Enode := Choice;
else
Enode := Lo;
end if;
-- Specialize message for integer/enum type
if Is_Integer_Type (Bounds_Type) then
Error_Msg_Uint_1 := Bounds_Lo;
Error_Msg_N ("minimum allowed choice value is^", Lo);
Error_Msg_N ("minimum allowed choice value is^", Enode);
else
Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
Error_Msg_N ("minimum allowed choice value is%", Lo);
Error_Msg_N ("minimum allowed choice value is%", Enode);
end if;
end if;
-- Check for high bound out of range
if Hi_Val > Bounds_Hi then
-- If the choice is an entity name, then it is a type, and
-- we want to post the message on the reference to this
-- entity. Otherwise we want to post it on the upper bound
-- of the range.
if Is_Entity_Name (Choice) then
Enode := Choice;
else
Enode := Hi;
end if;
-- Specialize message for integer/enum type
elsif Hi_Val > Bounds_Hi then
if Is_Integer_Type (Bounds_Type) then
Error_Msg_Uint_1 := Bounds_Hi;
Error_Msg_N ("maximum allowed choice value is^", Hi);
Error_Msg_N ("maximum allowed choice value is^", Enode);
else
Error_Msg_Name_1 := Choice_Image (Bounds_Hi, Bounds_Type);
Error_Msg_N ("maximum allowed choice value is%", Hi);
Error_Msg_N ("maximum allowed choice value is%", Enode);
end if;
end if;
......
gcc/ada/sem_ch10.adb
......@@ -958,9 +958,15 @@ package body Sem_Ch10 is
then
Comp_Unit := Cunit (Unum);
Set_Corresponding_Stub (Unit (Comp_Unit), N);
Analyze_Subunit (Comp_Unit);
Set_Library_Unit (N, Comp_Unit);
if Nkind (Unit (Comp_Unit)) /= N_Subunit then
Error_Msg_N
("expected SEPARATE subunit, found child unit",
Cunit_Entity (Unum));
else
Set_Corresponding_Stub (Unit (Comp_Unit), N);
Analyze_Subunit (Comp_Unit);
Set_Library_Unit (N, Comp_Unit);
end if;
elsif Unum = No_Unit
and then Present (Nam)
......
gcc/ada/sem_ch4.adb
......@@ -29,7 +29,6 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Util; use Exp_Util;
with Hostparm; use Hostparm;
with Itypes; use Itypes;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
......@@ -285,14 +284,7 @@ package body Sem_Ch4 is
List_Operand_Interps (Left_Opnd (N));
List_Operand_Interps (Right_Opnd (N));
else
if OpenVMS then
Error_Msg_N (
"\use '/'R'E'P'O'R'T'_'E'R'R'O'R'S'='F'U'L'L for details",
N);
else
Error_Msg_N ("\use -gnatf for details", N);
end if;
Error_Msg_N ("\use -gnatf switch for details", N);
end if;
end Ambiguous_Operands;
......
gcc/ada/sem_elim.adb
......@@ -289,11 +289,11 @@ package body Sem_Elim is
-- Then we need to see if the static scope matches within the
-- compilation unit.
-- At the moment, gnatelim does not consider block statements as
-- scopes (even if a block is named)
Scop := Scope (E);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
......@@ -305,7 +305,6 @@ package body Sem_Elim is
end if;
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
......@@ -324,7 +323,6 @@ package body Sem_Elim is
end if;
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
......
gcc/ada/sinfo.adb
......@@ -861,7 +861,7 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_With_Clause);
return Flag15 (N);
return Flag14 (N);
end Elaborate_All_Present;
function Elaborate_Present
......@@ -2040,7 +2040,8 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_Compilation_Unit
or else NT (N).Nkind = N_Formal_Derived_Type_Definition);
or else NT (N).Nkind = N_Formal_Derived_Type_Definition
or else NT (N).Nkind = N_With_Clause);
return Flag15 (N);
end Private_Present;
......@@ -3317,7 +3318,7 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_With_Clause);
Set_Flag15 (N, Val);
Set_Flag14 (N, Val);
end Set_Elaborate_All_Present;
procedure Set_Elaborate_Present
......@@ -4487,7 +4488,8 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_Compilation_Unit
or else NT (N).Nkind = N_Formal_Derived_Type_Definition);
or else NT (N).Nkind = N_Formal_Derived_Type_Definition
or else NT (N).Nkind = N_With_Clause);
Set_Flag15 (N, Val);
end Set_Private_Present;
......
gcc/ada/sinfo.ads
......@@ -825,7 +825,7 @@ package Sinfo is
-- This flag is set in the N_With_Clause node to indicate that a
-- pragma Elaborate pragma appears for the with'ed units.
-- Elaborate_All_Present (Flag15-Sem)
-- Elaborate_All_Present (Flag14-Sem)
-- This flag is set in the N_With_Clause node to indicate that a
-- pragma Elaborate_All pragma appears for the with'ed units.
......@@ -872,7 +872,7 @@ package Sinfo is
-- generic templates, this is harmless.
-- Entity_Or_Associated_Node (Node4-Sem)
-- A synonym for both Entity and Asasociated_Node. Used by convention
-- A synonym for both Entity and Associated_Node. Used by convention
-- in the code when referencing this field in cases where it is not
-- known whether the field contains an Entity or an Associated_Node.
......@@ -5102,7 +5102,8 @@ package Sinfo is
-- Last_Name (Flag6) (set to True if last name or only one name)
-- Context_Installed (Flag13-Sem)
-- Elaborate_Present (Flag4-Sem)
-- Elaborate_All_Present (Flag15-Sem)
-- Elaborate_All_Present (Flag14-Sem)
-- Private_Present (Flag15) set if with_clause has private keyword
-- Implicit_With (Flag16-Sem)
-- Limited_Present (Flag17) set if LIMITED is present
-- Limited_View_Installed (Flag18-Sem)
......@@ -5111,6 +5112,7 @@ package Sinfo is
-- Note: Limited_Present and Limited_View_Installed give support to
-- Ada 0Y (AI-50217).
-- Similarly, Private_Present gives support to AI-50262.
----------------------
-- With_Type clause --
......@@ -7120,7 +7122,7 @@ package Sinfo is
(N : Node_Id) return Boolean; -- Flag13
function Elaborate_All_Present
(N : Node_Id) return Boolean; -- Flag15
(N : Node_Id) return Boolean; -- Flag14
function Elaborate_Present
(N : Node_Id) return Boolean; -- Flag4
......@@ -7906,7 +7908,7 @@ package Sinfo is
(N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Elaborate_All_Present
(N : Node_Id; Val : Boolean := True); -- Flag15
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Elaborate_Present
(N : Node_Id; Val : Boolean := True); -- Flag4
......
gcc/ada/utils.c
......@@ -791,8 +791,11 @@ finish_record_type (tree record_type,
DECL_BIT_FIELD (field) = 0;
/* If we still have DECL_BIT_FIELD set at this point, we know the field
is technically not addressable. */
DECL_NONADDRESSABLE_P (field) |= DECL_BIT_FIELD (field);
is technically not addressable. Except that it can actually be
addressed if the field is BLKmode and happens to be properly
aligned. */
DECL_NONADDRESSABLE_P (field)
|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
if (has_rep && ! DECL_BIT_FIELD (field))
TYPE_ALIGN (record_type)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment