2004-05-17 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>

	Part of function-at-a-time conversion

	* misc.c (adjust_decl_rtl): Deleted.
	(LANG_HOOKS_PUSHLEVEL, LANG_HOOKS_POPLEVEL, LANG_HOOKS_SET_BLOCK):
	Define.

	* gigi.h: (adjust_decl_rtl, kept_level_p, set_block): Deleted.
	(add_decl_stmt, add_stmt, block_has_vars): New functions.
	(gnat_pushlevel, gnat_poplevel): Renamed from pushlevel and poplevel.

	* decl.c (elaborate_expression, maybe_pad_type): Call add_decl_stmt
	when making a decl.
	(gnat_to_gnu_entity): Likewise.
	Use add_stmt to update setjmp buffer.
	Set TREE_ADDRESSABLE instead of calling put_var_into_stack and
	flush_addressof.
	No longer call adjust_decl_rtl.
	(DECL_INIT_BY_ASSIGN_P): New macro.
	(DECL_STMT_VAR): Likewise.

	* trans.c (gigi): Call start_block_stmt to make the outermost
	BLOCK_STMT.
	(gnat_to_code, gnu_to_gnu, tree_transform, process_decls, process_type):
	Call start_block_stmt and end_block_stmt temporarily.
	Use gnat_expand_stmt instead of expand_expr_stmt.
	(add_decl_stmt): New function.
	(tree_transform): Call it.
	(add_stmt): Also emit initializing assignment for DECL_STMT if needed.
	(end_block_stmt): Set type and NULL_STMT.
	(gnat_expand_stmt): Make recursize call instead of calling
	expand_expr_stmt.
	(gnat_expand_stmt, case DECL_STMT): New case.
	(set_lineno_from_sloc): Do nothing if global.
	(gnu_block_stmt_node, gnu_block_stmt_free_list): New variables.
	(start_block_stmt, add_stmt, end_block_stmt): New functions.
	(build_block_stmt): Call them.
	(gnat_to_code): Don't expand NULL_STMT.
	(build_unit_elab): Rename pushlevel and poplevel to gnat_* and change
	args.
	(tree_transform): Likewise.
	(tree_transform, case N_Null_Statement): Return NULL_STMT.
	(gnat_expand_stmt, case NULL_STMT): New case.
	(gnat_expand_stmt, case IF_STMT): Allow nested IF_STMT to have no
	IF_STMT_TRUE.

	* utils2.c (gnat_mark_addressable, case VAR_DECL): Do not set
	TREE_ADDRESSABLE.

	* utils.c (create_var_decl): Do not call expand_decl or
	expand_decl_init.
	Set TREE_ADDRESSABLE instead of calling gnat_mark_addressable.
	Set DECL_INIT_BY_ASSIGN_P when needed and do not generate MODIFY_EXPR
	here.
	(struct e_stack): Add chain_next to GTY.
	(struct binding_level): Deleted.
	(struct ada_binding_level): New struct.
	(free_block_chain): New.
	(global_binding_level, clear_binding_level): Deleted.
	(global_bindings_p): Rework to see if no chain.
	(kept_level_p, set_block): Deleted.
	(gnat_pushlevel): Renamed from pushlevel and extensive reworked to use
	new data structure and work directly on BLOCK node.
	(gnat_poplevel): Similarly.
	(get_decls): Look at BLOCK_VARS.
	(insert_block): Work directly on BLOCK node.
	(block_has_var): New function.
	(pushdecl): Rework for new binding structures.
	(gnat_init_decl_processing): Rename and rework calls to pushlevel and
	poplevel.
	(build_subprog_body): Likewise.
	(end_subprog_body): Likewise; also set up BLOCK in DECL_INITIAL.

	* ada-tree.def (DECL_STMT, NULL_STMT): New codes.

	* ada-tree.h: (DECL_INIT_BY_ASSIGN_P): New macro.
	(DECL_STMT_VAR): Likewise.

2004-05-17  Robert Dewar  <dewar@gnat.com>

	* restrict.ads, restrict.adb (Process_Restriction_Synonym): New
	procedure

	* sem_prag.adb (Analyze_Pragma, case Restrictions): Cleanup handling
	of restriction synonyums by using
	Restrict.Process_Restriction_Synonyms.

	* snames.ads, snames.adb: Add entries for Process_Restriction_Synonym

	* s-restri.ads (Tasking_Allowed): Correct missing comment

	* s-rident.ads: Add entries for restriction synonyms

	* ali.adb: Fix some problems with badly formatted ALI files that can
	result in infinite loops.

	* s-taprop-lynxos.adb, s-tpopsp-lynxos.adb, s-taprop-tru64.adb,
	s-tpopsp-posix-foreign.adb, s-taprop-irix.adb, s-interr-sigaction.adb,
	s-taprop-irix-athread.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb,
	s-taprop-dummy.adb, s-interr-dummy.adb, s-taprop-os2.adb,
	s-taprop-solaris.adb, s-tpopsp-solaris.adb, s-asthan-vms.adb,
	s-inmaop-vms.adb, s-interr-vms.adb, s-taprop-vms.adb,
	s-tpopde-vms.adb, s-taprop-mingw.adb, s-interr-vxworks.adb,
	s-taprop-vxworks.adb, s-tpopsp-vxworks.adb, s-taprop-posix.adb,
	s-tpopsp-posix.adb, s-tratas-default.adb, a-dynpri.adb,
	a-tasatt.adb, a-taside.adb, a-taside.ads, exp_attr.adb,
	exp_ch9.adb, g-thread.adb, rtsfind.ads, sem_attr.adb,
	s-interr.adb, s-interr.ads, s-soflin.ads, s-taasde.adb,
	s-taasde.ads, s-taenca.adb, s-taenca.ads, s-taprop.ads,
	s-tarest.adb, s-tarest.ads, s-tasdeb.adb, s-tasdeb.ads,
	s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads,
	s-tassta.adb, s-tassta.ads, s-tasuti.adb, s-tasuti.ads,
	s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads,
	s-tpoben.adb, s-tpobop.adb, s-tpobop.ads, s-tporft.adb,
	s-tposen.adb, s-tposen.ads, s-tratas.adb, s-tratas.ads: Change Task_ID
	to Task_Id (minor cleanup).

2004-05-17  Vincent Celier  <celier@gnat.com>

	* g-os_lib.adb (Normalize_Pathname.Final_Value): Remove trailing
	directory separator.

	* prj-proc.adb (Recursive_Process): Inherit attribute Languages from
	project being extended, if Languages is not declared in extending
	project.

2004-05-17  Javier Miranda  <miranda@gnat.com>

	* sem_ch10.adb (Install_Limited_Withed_Unit): Do not install the
	limited view of a visible sibling.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81935 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 28 insertions, 98 deletions

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 5ab5bdeed45..5daafd59583 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3250,6 +3250,10 @@ package body Sem_Prag is
          procedure Set_Warning (R : All_Restrictions);
          --  If this is a Restriction_Warnings pragma, set warning flag
 
+         -----------------
+         -- Set_Warning --
+         -----------------
+
          procedure Set_Warning (R : All_Restrictions) is
          begin
             if Prag_Id = Pragma_Restriction_Warnings then
@@ -3269,119 +3273,45 @@ package body Sem_Prag is
             Id := Chars (Arg);
             Expr := Expression (Arg);
 
-            --  Case of no restriction identifier
+            --  Case of no restriction identifier present
 
             if Id = No_Name then
                if Nkind (Expr) /= N_Identifier then
                   Error_Pragma_Arg
                     ("invalid form for restriction", Arg);
+               end if;
 
-               --  Deal with synonyms. This should be done more cleanly ???
-
-               else
-                  --  Boolean_Entry_Barriers is a synonym of Simple_Barriers
-
-                  if Chars (Expr) = Name_Boolean_Entry_Barriers then
-                     Check_Restriction
-                       (No_Implementation_Restrictions, Arg);
-                     Set_Restriction (Simple_Barriers, N);
-                     Set_Warning (Simple_Barriers);
-
-                  --  Max_Entry_Queue_Depth is a synonym of
-                  --  Max_Entry_Queue_Length
-
-                  elsif Chars (Expr) = Name_Max_Entry_Queue_Depth then
-                     Analyze_And_Resolve (Expr, Any_Integer);
-
-                     if not Is_OK_Static_Expression (Expr) then
-                        Flag_Non_Static_Expr
-                          ("value must be static expression!", Expr);
-                        raise Pragma_Exit;
-
-                     elsif not Is_Integer_Type (Etype (Expr))
-                       or else Expr_Value (Expr) < 0
-                     then
-                        Error_Pragma_Arg
-                          ("value must be non-negative integer", Arg);
-
-                     --  Restriction pragma is active
-
-                     else
-                        Val := Expr_Value (Expr);
-
-                        if not UI_Is_In_Int_Range (Val) then
-                           Error_Pragma_Arg
-                             ("pragma ignored, value too large?", Arg);
-                        else
-                           Set_Restriction (Max_Entry_Queue_Length, N,
-                                            Integer (UI_To_Int (Val)));
-                           Set_Warning (Max_Entry_Queue_Length);
-                        end if;
-                     end if;
-
-                  --  No_Dynamic_Interrupts is a synonym for
-                  --  No_Dynamic_Attachment
-
-                  elsif Chars (Expr) = Name_No_Dynamic_Interrupts then
-                     Check_Restriction
-                       (No_Implementation_Restrictions, Arg);
-                     Set_Restriction (No_Dynamic_Attachment, N);
-                     Set_Warning (No_Dynamic_Attachment);
-
-                  --  No_Requeue is a synonym for No_Requeue_Statements
-
-                  elsif Chars (Expr) = Name_No_Requeue then
-                     Check_Restriction
-                       (No_Implementation_Restrictions, Arg);
-                     Set_Restriction (No_Requeue_Statements, N);
-                     Set_Warning (No_Requeue_Statements);
-
-                  --  No_Task_Attributes is a synonym for
-                  --  No_Task_Attributes_Package
-
-                  elsif Chars (Expr) = Name_No_Task_Attributes then
-                     Check_Restriction
-                       (No_Implementation_Restrictions, Arg);
-                     Set_Restriction (No_Task_Attributes_Package, N);
-                     Set_Warning (No_Task_Attributes_Package);
-
-                  --  Normal processing for all other cases
-
-                  else
-                     R_Id := Get_Restriction_Id (Chars (Expr));
-
-                     if R_Id not in All_Boolean_Restrictions then
-                        Error_Pragma_Arg
-                          ("invalid restriction identifier", Arg);
+               R_Id :=
+                 Get_Restriction_Id
+                   (Process_Restriction_Synonyms (Chars (Expr)));
 
-                     --  Restriction is active
+               if R_Id not in All_Boolean_Restrictions then
+                  Error_Pragma_Arg
+                    ("invalid restriction identifier", Arg);
+               end if;
 
-                     else
-                        if Implementation_Restriction (R_Id) then
-                           Check_Restriction
-                             (No_Implementation_Restrictions, Arg);
-                        end if;
+               if Implementation_Restriction (R_Id) then
+                  Check_Restriction
+                    (No_Implementation_Restrictions, Arg);
+               end if;
 
-                        Set_Restriction (R_Id, N);
-                        Set_Warning (R_Id);
+               Set_Restriction (R_Id, N);
+               Set_Warning (R_Id);
 
-                        --  A very special case that must be processed here:
-                        --  pragma Restrictions (No_Exceptions) turns off
-                        --  all run-time checking. This is a bit dubious in
-                        --  terms of the formal language definition, but it
-                        --  is what is intended by RM H.4(12).
+               --  A very special case that must be processed here:
+               --  pragma Restrictions (No_Exceptions) turns off
+               --  all run-time checking. This is a bit dubious in
+               --  terms of the formal language definition, but it
+               --  is what is intended by RM H.4(12).
 
-                        if R_Id = No_Exceptions then
-                           Scope_Suppress := (others => True);
-                        end if;
-                     end if;
-                  end if;
+               if R_Id = No_Exceptions then
+                  Scope_Suppress := (others => True);
                end if;
 
-               --  Case of restriction identifier present
+            --  Case of restriction identifier present
 
             else
-               R_Id := Get_Restriction_Id (Id);
+               R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Id));
                Analyze_And_Resolve (Expr, Any_Integer);
 
                if R_Id not in All_Parameter_Restrictions then