Commit af152989 by Arnaud Charlet

[multiple changes]

2004-04-08  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform): Shortcut returning error_mark_node for
	statements in annotate_only_mode.
	(tree_transform, case N_Label, case N_Return_Statement,
	N_Goto_Statement): Make statement tree instead of generating code.
	(tree_transform, case N_Assignment_Statement): No longer check
	type_annotate_only.
	(gnat_expand_stmt, case GOTO_STMT, case LABEL_STMT, case
	RETURN_STMT): New.
	(first_nondeleted_insn, build_block_stmt, make_expr_stmt_from_rtl):
	New fcns.
	(gnat_to_gnu): Collect any RTL generated and deal with it.
	(tree_transform, case N_And_Then): Refine when have non-null RTL_EXPR.
	(tree_transform case N_If_Statement): Rewrite to make IF_STMT.
	(gnat_expand_stmt, case BLOCK_STMT, IF_STMT): New cases.

	* ada-tree.def (GOTO_STMT, LABEL_STMT, RETURN_STMT): New tree nodes.

	* ada-tree.def (EXPR_STMT): Fix typo in name.
	(BLOCK_STMT, IF_STMT): New nodes.

	* ada-tree.h (GOTO_STMT_LABEL, LABEL_STMT_LABEL,
	LABEL_STMT_FIRST_IN_EH): New macros.
	(RETURN_STMT_EXPR): Likewise.

	* ada-tree.h: (BLOCK_STMT_LIST, IF_STMT_COND, IF_STMT_TRUE,
	IF_STMT_ELSEIF, IF_STMT_ELSE): New macros.

2004-04-08  Thomas Quinot  <quinot@act-europe.fr>

	* atree.ads: Correct documentation on extended nodes.

	* link.c: Set run_path_option for FreeBSD.

2004-04-08  Vincent Celier  <celier@gnat.com>

	* mlib-prj.adb (Build_Library.Check_Libs): On OpenVMS, if dec.ali is
	one of the ALI file, do not link with DEC lib.

	* par.adb Remove the last two characters ("%s" or "%b") when checking
	if a language defined unit may be recompiled.

2004-04-08  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch4.adb (Remove_Abstract_Operations): Improve error message when
	removal of abstract operation leaves no possible interpretation for
	expression.

	* sem_eval.adb (Eval_Qualified_Expression): Use
	Set_Raises_Constraint_Error on node when needed, so that it does not
	get optimized away by subsequent optimizations.

	* sem_res.adb (Resolve_Intrinsic_Operator): Save interpretations of
	operands even when they are not wrapped in a type conversion.

2004-04-08  Olivier Hainque  <hainque@act-europe.fr>

	* sem_prag.adb (Set_Exported): Warn about making static as result of
	export only when the export is coming from source. This may be not
	be true e.g. on VMS where we expand export pragmas for exception codes
	together with imported or exported exceptions, and we don't want the
	user to be warned about something he didn't write.

2004-04-08  Thomas Quinot  <quinot@act-europe.fr>

	* sem_util.adb (Note_Possible_Modification): Reorganize to remove code
	duplication between normal entities and those declared as renamings.
	No functional change.

	* s-fileio.ads (Form): Remove pragma Inline, as we cannot currently
	inline functions returning an unconstrained result.

2004-04-08  Eric Botcazou  <ebotcazou@act-europe.fr>

	* utils.c (type_for_mode): Handle BLKmode and VOIDmode properly, to
	conform to what other front-ends do.

2004-04-08  Doug Rupp  <rupp@gnat.com>

	* 5vml-tgt.adb: Use Gas instead of VMS Macro to build auto init shared
	libraries.

From-SVN: r80504
parent 2897f1d4
......@@ -50,15 +50,10 @@ package body MLib.Tgt is
-- Used to add the generated auto-init object files for auto-initializing
-- stand-alone libraries.
Macro_Name : constant String := "macro";
Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
-- The name of the command to invoke the macro-assembler
-- Options to use when invoking gcc to build the dynamic library
No_Start_Files : aliased String := "-nostartfiles";
VMS_Options : Argument_List :=
(No_Start_Files'Access, null);
VMS_Options : Argument_List := (1 .. 1 => null);
Gnatsym_Name : constant String := "gnatsym";
......@@ -272,7 +267,7 @@ package body MLib.Tgt is
new String'("--for-linker=" & Opt_File_Name & "/OPTIONS");
end if;
VMS_Options (VMS_Options'First + 1) := For_Linker_Opt;
VMS_Options (VMS_Options'First) := For_Linker_Opt;
for J in Inter'Range loop
To_Lower (Inter (J).all);
......@@ -293,7 +288,7 @@ package body MLib.Tgt is
if Auto_Init then
declare
Macro_File_Name : constant String := Lib_Filename & "$init.mar";
Macro_File_Name : constant String := Lib_Filename & "$init.asm";
Macro_File : Ada.Text_IO.File_Type;
Init_Proc : String := Lib_Filename & "INIT";
Popen_Result : System.Address;
......@@ -319,13 +314,12 @@ package body MLib.Tgt is
begin
Create (Macro_File, Out_File, Macro_File_Name);
Put_Line (Macro_File, ASCII.HT & ".EXTRN LIB$INITIALIZE");
Put_Line (Macro_File, ASCII.HT & ".EXTRN " & Init_Proc);
Put_Line
(Macro_File,
ASCII.HT & ".PSECT LIB$INITIALIZE USR,GBL,NOEXE,NOWRT,LONG");
Put_Line (Macro_File, ASCII.HT & ".ADDRESS " & Init_Proc);
Put_Line (Macro_File, ASCII.HT & ".END");
ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT");
Put_Line
(Macro_File,
ASCII.HT & ".long " & Init_Proc);
Close (Macro_File);
......
2004-04-08 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (tree_transform): Shortcut returning error_mark_node for
statements in annotate_only_mode.
(tree_transform, case N_Label, case N_Return_Statement,
N_Goto_Statement): Make statement tree instead of generating code.
(tree_transform, case N_Assignment_Statement): No longer check
type_annotate_only.
(gnat_expand_stmt, case GOTO_STMT, case LABEL_STMT, case
RETURN_STMT): New.
(first_nondeleted_insn, build_block_stmt, make_expr_stmt_from_rtl):
New fcns.
(gnat_to_gnu): Collect any RTL generated and deal with it.
(tree_transform, case N_And_Then): Refine when have non-null RTL_EXPR.
(tree_transform case N_If_Statement): Rewrite to make IF_STMT.
(gnat_expand_stmt, case BLOCK_STMT, IF_STMT): New cases.
* ada-tree.def (GOTO_STMT, LABEL_STMT, RETURN_STMT): New tree nodes.
* ada-tree.def (EXPR_STMT): Fix typo in name.
(BLOCK_STMT, IF_STMT): New nodes.
* ada-tree.h (GOTO_STMT_LABEL, LABEL_STMT_LABEL,
LABEL_STMT_FIRST_IN_EH): New macros.
(RETURN_STMT_EXPR): Likewise.
* ada-tree.h: (BLOCK_STMT_LIST, IF_STMT_COND, IF_STMT_TRUE,
IF_STMT_ELSEIF, IF_STMT_ELSE): New macros.
2004-04-08 Thomas Quinot <quinot@act-europe.fr>
* atree.ads: Correct documentation on extended nodes.
* link.c: Set run_path_option for FreeBSD.
2004-04-08 Vincent Celier <celier@gnat.com>
* mlib-prj.adb (Build_Library.Check_Libs): On OpenVMS, if dec.ali is
one of the ALI file, do not link with DEC lib.
* par.adb Remove the last two characters ("%s" or "%b") when checking
if a language defined unit may be recompiled.
2004-04-08 Ed Schonberg <schonberg@gnat.com>
* sem_ch4.adb (Remove_Abstract_Operations): Improve error message when
removal of abstract operation leaves no possible interpretation for
expression.
* sem_eval.adb (Eval_Qualified_Expression): Use
Set_Raises_Constraint_Error on node when needed, so that it does not
get optimized away by subsequent optimizations.
* sem_res.adb (Resolve_Intrinsic_Operator): Save interpretations of
operands even when they are not wrapped in a type conversion.
2004-04-08 Olivier Hainque <hainque@act-europe.fr>
* sem_prag.adb (Set_Exported): Warn about making static as result of
export only when the export is coming from source. This may be not
be true e.g. on VMS where we expand export pragmas for exception codes
together with imported or exported exceptions, and we don't want the
user to be warned about something he didn't write.
2004-04-08 Thomas Quinot <quinot@act-europe.fr>
* sem_util.adb (Note_Possible_Modification): Reorganize to remove code
duplication between normal entities and those declared as renamings.
No functional change.
* s-fileio.ads (Form): Remove pragma Inline, as we cannot currently
inline functions returning an unconstrained result.
2004-04-08 Eric Botcazou <ebotcazou@act-europe.fr>
* utils.c (type_for_mode): Handle BLKmode and VOIDmode properly, to
conform to what other front-ends do.
2004-04-08 Doug Rupp <rupp@gnat.com>
* 5vml-tgt.adb: Use Gas instead of VMS Macro to build auto init shared
libraries.
2004-04-06 Pascal Obry <obry@gnat.com>
* adaint.c (DIR_SEPARATOR): Properly set DIR_SEPARATOR on Win32.
......
......@@ -84,4 +84,26 @@ DEFTREECODE (GNAT_LOOP_ID, "gnat_loop_id", 'x', 0)
We start with an expression statement, whose only operand is an
expression, EXPR_STMT_EXPR, Execution of the statement means evaluation of
the expression (such as a MODIFY_EXPR) and discarding its result. */
DEFTREECODE (EXPR_STMT, "expr_stmt_expr", 's', 1)
DEFTREECODE (EXPR_STMT, "expr_stmt", 's', 1)
/* This represents a list of statements. BLOCK_STMT_LIST is a list
statement tree, chained via TREE_CHAIN. */
DEFTREECODE (BLOCK_STMT, "block_stmt", 's', 1)
/* This is an IF statement. IF_STMT_COND is the condition being tested,
IF_STMT_TRUE is the statement to be executed if the condition is
true; IF_STMT_ELSEIF, if non-null, is a list of more IF_STMT nodes (where
we only look at IF_STMT_COND and IF_STMT_TRUE) that correspond to
any "else if" parts; and IF_STMT_ELSE is the statement to be executed if
all conditions are. */
DEFTREECODE (IF_STMT, "if_stmt", 's', 4)
/* A goto just points to the label: GOTO_STMT_LABEL. */
DEFTREECODE (GOTO_STMT, "goto_stmt", 's', 1)
/* A label: LABEL_STMT_LABEL is the label and LABEL_STMT_FIRST_IN_EH is set
if this is the first label of an exception handler. */
DEFTREECODE (LABEL_STMT, "label_stmt", 's', 1)
/* A "return". RETURN_STMT_EXPR is the value to return if non-null. */
DEFTREECODE (RETURN_STMT, "return_stmt", 's', 1)
......@@ -294,5 +294,15 @@ struct lang_type GTY(())
/* We store the Sloc in statement nodes. */
#define TREE_SLOC(NODE) TREE_COMPLEXITY (STMT_CHECK (NODE))
/* There is just one field in an EXPR_STMT: the expression. */
#define EXPR_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXPR_STMT, 0)
#define BLOCK_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 0)
#define IF_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 0)
#define IF_STMT_TRUE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 1)
#define IF_STMT_ELSEIF(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 2)
#define IF_STMT_ELSE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 3)
#define GOTO_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, GOTO_STMT, 0)
#define LABEL_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LABEL_STMT, 0)
#define LABEL_STMT_FIRST_IN_EH(NODE) \
(LABEL_STMT_CHECK (NODE)->common.unsigned_flag)
#define RETURN_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, RETURN_STMT, 0)
......@@ -495,7 +495,7 @@ package Atree is
function Extend_Node (Node : Node_Id) return Entity_Id;
-- This function returns a copy of its input node with an extension
-- added. The fields of the extension are set to Empty. Due to the way
-- extensions are handled (as two consecutive array elements), it may
-- extensions are handled (as four consecutive array elements), it may
-- be necessary to reallocate the node, so that the returned value is
-- not the same as the input value, but where possible the returned
-- value will be the same as the input value (i.e. the extension will
......
......@@ -156,7 +156,7 @@ const char *object_library_extension = ".a";
#elif defined (__FreeBSD__)
char *object_file_option = "";
char *run_path_option = "";
char *run_path_option = "-Wl,-rpath,";
char shared_libgnat_default = STATIC;
int link_max = 2147483647;
unsigned char objlist_file_supported = 0;
......
......@@ -308,6 +308,9 @@ package body MLib.Prj is
Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with libdecgnat
Check_Libdecgnat : Boolean := Hostparm.OpenVMS;
-- Set to False if package Dec is part of the library sources.
Data : Project_Data := Projects.Table (For_Project);
Object_Directory_Path : constant String :=
......@@ -372,7 +375,8 @@ package body MLib.Prj is
-- to link with -lgnarl (this is the case when there is a dependency
-- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
-- indicates that there is a need to link with -ldecgnat (this is the
-- case when there is a dependency on dec.ads).
-- case when there is a dependency on dec.ads, except when it is the
-- DEC library, the one that contains package DEC).
procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the
......@@ -504,12 +508,17 @@ package body MLib.Prj is
Text : Text_Buffer_Ptr;
Id : ALI.ALI_Id;
pragma Warnings (Off, Id);
-- Comment needed ???
begin
-- On OpenVMS, if we have package DEC, it means this is the DEC lib:
-- no need to link with itself.
if Check_Libdecgnat and then ALI_File = "dec.ali" then
Check_Libdecgnat := False;
Libdecgnat_Needed := False;
end if;
if not Libgnarl_Needed or
(Hostparm.OpenVMS and then (not Libdecgnat_Needed))
(Check_Libdecgnat and then (not Libdecgnat_Needed))
then
-- Scan the ALI file
......@@ -526,7 +535,7 @@ package body MLib.Prj is
Read_Lines => "D");
Free (Text);
-- Look for s-osinte.ads in the dependencies
-- Look for s-osinte.ads and dec.ads in the dependencies
for Index in ALI.ALIs.Table (Id).First_Sdep ..
ALI.ALIs.Table (Id).Last_Sdep
......@@ -534,7 +543,7 @@ package body MLib.Prj is
if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
Libgnarl_Needed := True;
elsif Hostparm.OpenVMS and then
elsif Check_Libdecgnat and then
ALI.Sdep.Table (Index).Sfile = S_Dec_Ads
then
Libdecgnat_Needed := True;
......@@ -1941,7 +1950,10 @@ package body MLib.Prj is
end if;
Status := fclose (Fd);
-- Is it really right to ignore any close error ???
-- It is safe to ignore any error when closing, because the file was
-- only opened for reading.
end Process_Binder_File;
------------------
......
......@@ -1310,16 +1310,24 @@ begin
and then not GNAT_Mode
then
declare
Name : constant String :=
Get_Name_String
(Unit_Name (Current_Source_Unit));
Uname : constant String :=
Get_Name_String
(Unit_Name (Current_Source_Unit));
Name : String (1 .. Uname'Length - 2);
begin
if (Name = "ada" or else
Name = "calendar" or else
Name = "interfaces" or else
Name = "system" or else
Name = "machine_code" or else
Name = "unchecked_conversion" or else
-- Because Unit_Name includes "%s" or "%b", we need to
-- strip the last two characters to get the real unit
-- name.
Name := Uname (Uname'First .. Uname'Last - 2);
if (Name = "ada" or else
Name = "calendar" or else
Name = "interfaces" or else
Name = "system" or else
Name = "machine_code" or else
Name = "unchecked_conversion" or else
Name = "unchecked_deallocation"
or else (Name'Length > 4
and then
......
......@@ -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- --
......@@ -250,7 +250,6 @@ package System.File_IO is
private
pragma Inline (Check_Read_Status);
pragma Inline (Check_Write_Status);
pragma Inline (Form);
pragma Inline (Mode);
end System.File_IO;
......@@ -4332,7 +4332,7 @@ package body Sem_Ch4 is
procedure Remove_Abstract_Operations (N : Node_Id) is
I : Interp_Index;
It : Interp;
Has_Abstract_Op : Boolean := False;
Abstract_Op : Entity_Id := Empty;
-- AI-310: If overloaded, remove abstract non-dispatching
-- operations.
......@@ -4347,7 +4347,7 @@ package body Sem_Ch4 is
and then Is_Abstract (It.Nam)
and then not Is_Dispatching_Operation (It.Nam)
then
Has_Abstract_Op := True;
Abstract_Op := It.Nam;
Remove_Interp (I);
exit;
end if;
......@@ -4359,7 +4359,7 @@ package body Sem_Ch4 is
-- always added to the overload set, unless it is a universal
-- operation.
if not Has_Abstract_Op then
if No (Abstract_Op) then
return;
elsif Nkind (N) in N_Op then
......@@ -4398,10 +4398,9 @@ package body Sem_Ch4 is
begin
if Present (Universal_Interpretation (Arg1))
or else
(Present (Next (Arg1))
and then
Present (Universal_Interpretation (Next (Arg1))))
and then
(No (Next (Arg1))
or else Present (Universal_Interpretation (Next (Arg1))))
then
return;
......@@ -4417,6 +4416,23 @@ package body Sem_Ch4 is
end if;
end;
end if;
-- If the removal has left no valid interpretations, emit
-- error message now an label node as illegal.
if Present (Abstract_Op) then
Get_First_Interp (N, I, It);
if No (It.Nam) then
-- Removal of abstract operation left no viable candidate.
Set_Etype (N, Any_Type);
Error_Msg_Sloc := Sloc (Abstract_Op);
Error_Msg_NE
("cannot call abstract operation& declared#", N, Abstract_Op);
end if;
end if;
end if;
end Remove_Abstract_Operations;
......
......@@ -1947,6 +1947,13 @@ package body Sem_Eval is
or else Nkind (Parent (N)) = N_Allocator
then
Check_Non_Static_Context (Operand);
-- If operand is known to raise constraint_error, set the
-- flag on the expression so it does not get optimized away.
if Nkind (Operand) = N_Raise_Constraint_Error then
Set_Raises_Constraint_Error (N);
end if;
return;
end if;
......
......@@ -3555,7 +3555,15 @@ package body Sem_Prag is
Set_Is_Public (E);
Set_Is_Statically_Allocated (E);
if Warn_On_Export_Import then
-- Warn if the corresponding W flag is set and the pragma
-- comes from source. The latter may be not be true e.g. on
-- VMS where we expand export pragmas for exception codes
-- associated with imported or exported exceptions. We don't
-- want the user to be warned about something he didn't write.
if Warn_On_Export_Import
and then Comes_From_Source (Arg)
then
Error_Msg_NE
("?& has been made static as a result of Export", Arg, E);
Error_Msg_N
......
......@@ -4965,6 +4965,7 @@ package body Sem_Res is
end loop;
Set_Entity (N, Op);
Set_Is_Overloaded (N, False);
-- If the operand type is private, rewrite with suitable
-- conversions on the operands and the result, to expose
......@@ -4993,17 +4994,21 @@ package body Sem_Res is
or else Typ /= Etype (Right_Opnd (N))
then
-- Add explicit conversion where needed, and save interpretations
-- if operands are overloaded.
-- in case operands are overloaded.
Arg1 := Convert_To (Typ, Left_Opnd (N));
Arg1 := Convert_To (Typ, Left_Opnd (N));
Arg2 := Convert_To (Typ, Right_Opnd (N));
if Nkind (Arg1) = N_Type_Conversion then
Save_Interps (Left_Opnd (N), Expression (Arg1));
else
Save_Interps (Left_Opnd (N), Arg1);
end if;
if Nkind (Arg2) = N_Type_Conversion then
Save_Interps (Right_Opnd (N), Expression (Arg2));
else
Save_Interps (Right_Opnd (N), Arg1);
end if;
Rewrite (Left_Opnd (N), Arg1);
......
......@@ -4985,41 +4985,12 @@ package body Sem_Util is
Ent : Entity_Id;
Exp : Node_Id;
procedure Set_Ref (E : Entity_Id; N : Node_Id);
-- Internal routine to note modification on entity E by node N
-- Has no effect if entity E does not represent an object.
-------------
-- Set_Ref --
-------------
procedure Set_Ref (E : Entity_Id; N : Node_Id) is
begin
if Is_Object (E) then
if Comes_From_Source (N)
or else Modification_Comes_From_Source
then
Set_Never_Set_In_Source (E, False);
end if;
Set_Is_True_Constant (E, False);
Set_Current_Value (E, Empty);
Generate_Reference (E, N, 'm');
Kill_Checks (E);
if not Can_Never_Be_Null (E) then
Set_Is_Known_Non_Null (E, False);
end if;
end if;
end Set_Ref;
-- Start of processing for Note_Possible_Modification
begin
-- Loop to find referenced entity, if there is one
Exp := N;
loop
<<Continue>>
Ent := Empty;
if Is_Entity_Name (Exp) then
......@@ -5074,10 +5045,14 @@ package body Sem_Util is
-- Now look for entity being referenced
if Present (Ent) then
if (Ekind (Ent) = E_Variable or else Ekind (Ent) = E_Constant)
and then Present (Renamed_Object (Ent))
then
Set_Never_Set_In_Source (Ent, False);
if Is_Object (Ent) then
if Comes_From_Source (Exp)
or else Modification_Comes_From_Source
then
Set_Never_Set_In_Source (Ent, False);
end if;
Set_Is_True_Constant (Ent, False);
Set_Current_Value (Ent, Empty);
......@@ -5085,13 +5060,18 @@ package body Sem_Util is
Set_Is_Known_Non_Null (Ent, False);
end if;
Exp := Renamed_Object (Ent);
if (Ekind (Ent) = E_Variable or else Ekind (Ent) = E_Constant)
and then Present (Renamed_Object (Ent))
then
Exp := Renamed_Object (Ent);
goto Continue;
end if;
else
Set_Ref (Ent, Exp);
Kill_Checks (Ent);
return;
Generate_Reference (Ent, Exp, 'm');
end if;
Kill_Checks (Ent);
return;
end if;
end loop;
end Note_Possible_Modification;
......
......@@ -2069,7 +2069,11 @@ float_type_for_precision (int precision, enum machine_mode mode)
tree
gnat_type_for_mode (enum machine_mode mode, int unsignedp)
{
if (GET_MODE_CLASS (mode) == MODE_FLOAT)
if (mode == BLKmode)
return NULL_TREE;
else if (mode == VOIDmode)
return void_type_node;
else if (GET_MODE_CLASS (mode) == MODE_FLOAT)
return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
else
return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
......
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