diff options
91 files changed, 2144 insertions, 1917 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 16d3d0a7225..c311e987132 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,136 @@ +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. + 2004-05-14 Robert Dewar <dewar@gnat.com> * gnat_ugn.texi: Minor change to -gnatS documentation diff --git a/gcc/ada/a-dynpri.adb b/gcc/ada/a-dynpri.adb index f4468adcd48..3cf82dda8b4 100644 --- a/gcc/ada/a-dynpri.adb +++ b/gcc/ada/a-dynpri.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -45,7 +45,7 @@ with System.Task_Primitives.Operations; -- Self with System.Tasking; --- used for Task_ID +-- used for Task_Id with Ada.Exceptions; -- used for Raise_Exception @@ -68,7 +68,7 @@ package body Ada.Dynamic_Priorities is function Convert_Ids is new Unchecked_Conversion - (Task_Identification.Task_Id, System.Tasking.Task_ID); + (Task_Identification.Task_Id, System.Tasking.Task_Id); ------------------ -- Get_Priority -- @@ -78,10 +78,9 @@ package body Ada.Dynamic_Priorities is function Get_Priority (T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) - return System.Any_Priority is - - Target : constant Task_ID := Convert_Ids (T); + Ada.Task_Identification.Current_Task) return System.Any_Priority + is + Target : constant Task_Id := Convert_Ids (T); Error_Message : constant String := "Trying to get the priority of a "; begin @@ -106,11 +105,11 @@ package body Ada.Dynamic_Priorities is procedure Set_Priority (Priority : System.Any_Priority; - T : Ada.Task_Identification.Task_Id := - Ada.Task_Identification.Current_Task) + T : Ada.Task_Identification.Task_Id := + Ada.Task_Identification.Current_Task) is - Target : constant Task_ID := Convert_Ids (T); - Self_ID : constant Task_ID := STPO.Self; + Target : constant Task_Id := Convert_Ids (T); + Self_ID : constant Task_Id := STPO.Self; Error_Message : constant String := "Trying to set the priority of a "; begin @@ -142,20 +141,23 @@ package body Ada.Dynamic_Priorities is STPO.Unlock_RTS; end if; - STPO.Yield; -- Yield is needed to enforce FIFO task dispatching. - -- LL Set_Priority is made while holding the RTS lock so that - -- it is inheriting high priority until it release all the RTS - -- locks. + + -- LL Set_Priority is made while holding the RTS lock so that it + -- is inheriting high priority until it release all the RTS locks. + -- If this is used in a system where Ceiling Locking is -- not enforced we may end up getting two Yield effects. + STPO.Yield; + else Target.New_Base_Priority := Priority; Target.Pending_Priority_Change := True; Target.Pending_Action := True; STPO.Wakeup (Target, Target.Common.State); + -- If the task is suspended, wake it up to perform the change. -- check for ceiling violations ??? diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb index f68c6255a86..35801e2896e 100644 --- a/gcc/ada/a-tasatt.adb +++ b/gcc/ada/a-tasatt.adb @@ -41,7 +41,7 @@ -- we settled on the present compromise. Things we do not like about -- this implementation include: --- - It is vulnerable to bad Task_ID values, to the extent of +-- - It is vulnerable to bad Task_Id values, to the extent of -- possibly trashing memory and crashing the runtime system. -- - It requires dynamic storage allocation for each new attribute value, @@ -228,7 +228,7 @@ with Ada.Task_Identification; -- used for Task_Id --- Null_Task_ID +-- Null_Task_Id -- Current_Task with System.Error_Reporting; @@ -244,7 +244,7 @@ with System.Task_Primitives.Operations; with System.Tasking; -- used for Access_Address --- Task_ID +-- Task_Id -- Direct_Index_Vector -- Direct_Index @@ -336,8 +336,8 @@ package body Ada.Task_Attributes is (Access_Wrapper, Access_Dummy_Wrapper); -- To store pointer to actual wrapper of attribute node - function To_Task_ID is new Unchecked_Conversion - (Task_Identification.Task_Id, Task_ID); + function To_Task_Id is new Unchecked_Conversion + (Task_Identification.Task_Id, Task_Id); -- To access TCB of identified task type Local_Deallocator is access procedure (P : in out Access_Node); @@ -394,7 +394,7 @@ package body Ada.Task_Attributes is (T : Task_Identification.Task_Id := Task_Identification.Current_Task) return Attribute_Handle is - TT : constant Task_ID := To_Task_ID (T); + TT : constant Task_Id := To_Task_Id (T); Error_Message : constant String := "Trying to get the reference of a "; begin @@ -484,7 +484,7 @@ package body Ada.Task_Attributes is procedure Reinitialize (T : Task_Identification.Task_Id := Task_Identification.Current_Task) is - TT : constant Task_ID := To_Task_ID (T); + TT : constant Task_Id := To_Task_Id (T); Error_Message : constant String := "Trying to Reinitialize a "; begin @@ -554,7 +554,7 @@ package body Ada.Task_Attributes is (Val : Attribute; T : Task_Identification.Task_Id := Task_Identification.Current_Task) is - TT : constant Task_ID := To_Task_ID (T); + TT : constant Task_Id := To_Task_Id (T); Error_Message : constant String := "Trying to Set the Value of a "; begin @@ -643,7 +643,7 @@ package body Ada.Task_Attributes is (T : Task_Identification.Task_Id := Task_Identification.Current_Task) return Attribute is - TT : constant Task_ID := To_Task_ID (T); + TT : constant Task_Id := To_Task_Id (T); Error_Message : constant String := "Trying to get the Value of a "; begin @@ -782,7 +782,7 @@ begin -- Initialize the attribute, for all tasks. declare - C : System.Tasking.Task_ID := System.Tasking.All_Tasks_List; + C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List; begin while C /= null loop C.Direct_Attributes (Local.Index) := diff --git a/gcc/ada/a-taside.adb b/gcc/ada/a-taside.adb index c15ce991e0b..bec7cc25c85 100644 --- a/gcc/ada/a-taside.adb +++ b/gcc/ada/a-taside.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- 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- -- @@ -55,8 +55,8 @@ package body Ada.Task_Identification is -- Local Subprograms -- ----------------------- - function Convert_Ids (T : Task_Id) return System.Tasking.Task_ID; - function Convert_Ids (T : System.Tasking.Task_ID) return Task_Id; + function Convert_Ids (T : Task_Id) return System.Tasking.Task_Id; + function Convert_Ids (T : System.Tasking.Task_Id) return Task_Id; pragma Inline (Convert_Ids); -- Conversion functions between different forms of Task_Id @@ -87,12 +87,12 @@ package body Ada.Task_Identification is -- Convert_Ids -- ----------------- - function Convert_Ids (T : Task_Id) return System.Tasking.Task_ID is + function Convert_Ids (T : Task_Id) return System.Tasking.Task_Id is begin - return System.Tasking.Task_ID (T); + return System.Tasking.Task_Id (T); end Convert_Ids; - function Convert_Ids (T : System.Tasking.Task_ID) return Task_Id is + function Convert_Ids (T : System.Tasking.Task_Id) return Task_Id is begin return Task_Id (T); end Convert_Ids; diff --git a/gcc/ada/a-taside.ads b/gcc/ada/a-taside.ads index e0c93830155..c76d4db0fa7 100644 --- a/gcc/ada/a-taside.ads +++ b/gcc/ada/a-taside.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2000 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -64,8 +64,8 @@ package Ada.Task_Identification is private - type Task_Id is new System.Tasking.Task_ID; + type Task_Id is new System.Tasking.Task_Id; - Null_Task_ID : constant Task_Id := Task_Id (System.Tasking.Null_Task); + Null_Task_Id : constant Task_Id := Task_Id (System.Tasking.Null_Task); end Ada.Task_Identification; diff --git a/gcc/ada/ada-tree.def b/gcc/ada/ada-tree.def index e5fe7eb61fa..33032f59851 100644 --- a/gcc/ada/ada-tree.def +++ b/gcc/ada/ada-tree.def @@ -86,6 +86,13 @@ DEFTREECODE (GNAT_LOOP_ID, "gnat_loop_id", 'x', 0) the expression (such as a MODIFY_EXPR) and discarding its result. */ DEFTREECODE (EXPR_STMT, "expr_stmt", 's', 1) +/* This is a null statement. The intent is for it not to survive very far. */ +DEFTREECODE (NULL_STMT, "null_stmt", 's', 0) + +/* This defines the variable in DECL_STMT_VAR and performs any initialization + in DECL_INITIAL. */ +DEFTREECODE (DECL_STMT, "decl_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) diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h index 3f6faeddb30..d2361a5d858 100644 --- a/gcc/ada/ada-tree.h +++ b/gcc/ada/ada-tree.h @@ -238,6 +238,9 @@ struct lang_type GTY(()) discriminant. */ #define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE)) +/* Nonzero in a VAR_DECL if it needs to be initialized by an assignment. */ +#define DECL_INIT_BY_ASSIGN_P(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE)) + /* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF is needed to access the object. */ #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE) @@ -295,6 +298,7 @@ struct lang_type GTY(()) #define TREE_SLOC(NODE) TREE_COMPLEXITY (STMT_CHECK (NODE)) #define EXPR_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXPR_STMT, 0) +#define DECL_STMT_VAR(NODE) TREE_OPERAND_CHECK_CODE (NODE, DECL_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) diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 9561a11b143..28d02cc79ec 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -282,6 +282,7 @@ package body ALI is loop if C = CR or else C = LF then Skip_Line; + C := Nextc; elsif C = EOF then return; @@ -788,6 +789,7 @@ package body ALI is Fatal_Error; else Skip_Line; + C := Nextc; end if; else Fatal_Error; @@ -948,6 +950,7 @@ package body ALI is Fatal_Error; else Skip_Line; + C := Nextc; end if; else Fatal_Error; diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 92e1342feb9..806fd1a56ca 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -960,6 +960,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_var_decl (create_concat_name (gnat_entity, "ALIGN"), NULL_TREE, gnu_new_type, gnu_expr, 0, 0, 0, 0, 0); + add_decl_stmt (gnu_new_var, gnat_entity); if (gnu_expr != 0) expand_expr_stmt @@ -1041,6 +1042,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (Present (Address_Clause (gnat_entity)) && used_by_ref) DECL_POINTER_ALIAS_SET (gnu_decl) = 0; + add_decl_stmt (gnu_decl, gnat_entity); + if (definition && DECL_SIZE (gnu_decl) != 0 && gnu_block_stack != 0 && TREE_VALUE (gnu_block_stack) != 0 @@ -1048,11 +1051,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (flag_stack_check && ! STACK_CHECK_BUILTIN && 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl), STACK_CHECK_MAX_VAR_SIZE)))) - expand_expr_stmt - (build_call_1_expr (update_setjmp_buf_decl, - build_unary_op - (ADDR_EXPR, NULL_TREE, - TREE_VALUE (gnu_block_stack)))); + { + tree gnu_stmt + = build_nt (EXPR_STMT, + (build_call_1_expr + (update_setjmp_buf_decl, + build_unary_op + (ADDR_EXPR, NULL_TREE, + TREE_VALUE (gnu_block_stack))))); + + TREE_SLOC (gnu_stmt) = Sloc (gnat_entity); + TREE_TYPE (gnu_stmt) = void_type_node; + add_stmt (gnu_stmt); + } /* If this is a public constant or we're not optimizing and we're not making a VAR_DECL for it, make one just for export or debugger @@ -1064,21 +1075,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Address_Taken (gnat_entity) || Is_Aliased (gnat_entity) || Is_Aliased (Etype (gnat_entity)))) - SET_DECL_CONST_CORRESPONDING_VAR - (gnu_decl, - create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, - gnu_expr, 0, Is_Public (gnat_entity), 0, - static_p, 0)); + { + tree gnu_corr_var + = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, + gnu_expr, 0, Is_Public (gnat_entity), 0, + static_p, 0); + + add_decl_stmt (gnu_corr_var, gnat_entity); + SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); + } /* If this is declared in a block that contains an block with an exception handler, we must force this variable in memory to suppress an invalid optimization. */ if (Has_Nested_Block_With_Handler (Scope (gnat_entity)) && Exception_Mechanism != GCC_ZCX) - { - gnat_mark_addressable (gnu_decl); - flush_addressof (gnu_decl); - } + TREE_ADDRESSABLE (gnu_decl) = 1; /* Back-annotate the Alignment of the object if not already in the tree. Likewise for Esize if the object is of a constant size. @@ -1152,6 +1164,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_var_decl (get_entity_name (gnat_literal), 0, gnu_type, gnu_value, 1, 0, 0, 0, 0); + add_decl_stmt (gnu_literal, gnat_literal); save_gnu_tree (gnat_literal, gnu_literal, 0); gnu_literal_list = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_literal_list); @@ -3604,6 +3617,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_address, 0, Is_Public (gnat_entity), extern_flag, 0, 0); DECL_BY_REF_P (gnu_decl) = 1; + add_decl_stmt (gnu_decl, gnat_entity); } else if (kind == E_Subprogram_Type) @@ -3898,6 +3912,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } else TREE_TYPE (gnu_decl) = gnu_type; + + add_decl_stmt (gnu_decl, gnat_entity); } if (IN (kind, Type_Kind) && ! TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))) @@ -3959,10 +3975,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TREE_CODE (gnu_decl) != FUNCTION_DECL) DECL_IGNORED_P (gnu_decl) = 1; - /* If this decl is really indirect, adjust it. */ - if (TREE_CODE (gnu_decl) == VAR_DECL) - adjust_decl_rtl (gnu_decl); - /* If we haven't already, associate the ..._DECL node that we just made with the input GNAT entity node. */ if (! saved) @@ -4534,6 +4546,7 @@ elaborate_expression_1 (Node_Id gnat_expr, IDENTIFIER_POINTER (gnu_name)), NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1, Is_Public (gnat_entity), ! definition, 0, 0); + add_decl_stmt (gnu_decl, gnat_entity); } /* We only need to use this variable if we are in global context since GCC @@ -4679,14 +4692,9 @@ make_packable_type (tree type) type. */ static tree -maybe_pad_type (tree type, - tree size, - unsigned int align, - Entity_Id gnat_entity, - const char *name_trailer, - int is_user_type, - int definition, - int same_rm_size) +maybe_pad_type (tree type, tree size, unsigned int align, + Entity_Id gnat_entity, const char *name_trailer, + int is_user_type, int definition, int same_rm_size) { tree orig_size = TYPE_SIZE (type); tree record; @@ -4812,9 +4820,13 @@ maybe_pad_type (tree type, 0, 0); if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition) - create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE, - sizetype, TYPE_SIZE (record), 0, 0, 0, 0, - 0); + { + tree gnu_xvz + = create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE, + sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0); + + add_decl_stmt (gnu_xvz, gnat_entity); + } } type = record; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index edf358ef1b2..7b500d5276b 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1012,7 +1012,7 @@ package body Exp_Attr is -- Task_Entry_Caller or the Protected_Entry_Caller function. when Attribute_Caller => Caller : declare - Id_Kind : constant Entity_Id := RTE (RO_AT_Task_ID); + Id_Kind : constant Entity_Id := RTE (RO_AT_Task_Id); Ent : constant Entity_Id := Entity (Pref); Conctype : constant Entity_Id := Scope (Ent); Nest_Depth : Integer := 0; @@ -1662,7 +1662,7 @@ package body Exp_Attr is -- For a task it returns a reference to the _task_id component of -- corresponding record: - -- taskV!(Prefix)._Task_Id, converted to the type Task_ID defined + -- taskV!(Prefix)._Task_Id, converted to the type Task_Id defined -- in Ada.Task_Identification. @@ -1680,7 +1680,7 @@ package body Exp_Attr is Rewrite (N, Unchecked_Convert_To (Id_Kind, Make_Reference (Loc, Pref))); else - Id_Kind := RTE (RO_AT_Task_ID); + Id_Kind := RTE (RO_AT_Task_Id); Rewrite (N, Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref))); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index d8c43df42ad..f661c13c0ee 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2794,7 +2794,7 @@ package body Exp_Ch9 is Decl := Make_Object_Declaration (Loc, Defining_Identifier => T_Self, Object_Definition => - New_Occurrence_Of (RTE (RO_ST_Task_ID), Loc), + New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), Expression => Make_Function_Call (Loc, Name => New_Reference_To (RTE (RE_Self), Loc))); @@ -7223,7 +7223,7 @@ package body Exp_Ch9 is Component_Definition => Make_Component_Definition (Loc, Aliased_Present => False, - Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID), + Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_Id), Loc)))); -- Add components for entry families diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb index 473e0eb7e27..9566e21c3d7 100644 --- a/gcc/ada/g-os_lib.adb +++ b/gcc/ada/g-os_lib.adb @@ -1547,6 +1547,8 @@ package body GNAT.OS_Lib is S1 : String := S; -- We may need to fold S to lower case, so we need a variable + Last : Natural; + begin -- Interix has the non standard notion of disk drive -- indicated by two '/' followed by a capital letter @@ -1566,23 +1568,37 @@ package body GNAT.OS_Lib is begin Result (1) := '/'; Result (2 .. Result'Last) := S; + Last := Result'Last; if Fold_To_Lower_Case then System.Case_Util.To_Lower (Result); end if; - return Result; + -- Remove trailing directory separator, if any + + if Result (Last) = '/' or else + Result (Last) = Directory_Separator + then + Last := Last - 1; + end if; + return Result (1 .. Last); end; else - if Fold_To_Lower_Case then System.Case_Util.To_Lower (S1); end if; - return S1; + -- Remove trailing directory separator, if any + + Last := S1'Last; + + if S1 (Last) = '/' or else S1 (Last) = Directory_Separator then + Last := Last - 1; + end if; + return S1 (1 .. Last); end if; end Final_Value; diff --git a/gcc/ada/g-thread.adb b/gcc/ada/g-thread.adb index 98e663dc978..1642e54f80b 100644 --- a/gcc/ada/g-thread.adb +++ b/gcc/ada/g-thread.adb @@ -53,7 +53,7 @@ package body GNAT.Threads is function To_Addr is new Unchecked_Conversion (Task_Id, Address); function To_Id is new Unchecked_Conversion (Address, Task_Id); - function To_Id is new Unchecked_Conversion (Address, Tasking.Task_ID); + function To_Id is new Unchecked_Conversion (Address, Tasking.Task_Id); function To_Tid is new Unchecked_Conversion (Address, Ada.Task_Identification.Task_Id); function To_Thread is new Unchecked_Conversion (Address, Thread_Id_Ptr); @@ -112,7 +112,7 @@ package body GNAT.Threads is ----------------------- procedure Unregister_Thread is - Self_Id : constant Tasking.Task_ID := Task_Primitives.Operations.Self; + Self_Id : constant Tasking.Task_Id := Task_Primitives.Operations.Self; begin Self_Id.Common.State := Tasking.Terminated; Destroy_TSD (Self_Id.Common.Compiler_Data); @@ -125,9 +125,9 @@ package body GNAT.Threads is procedure Unregister_Thread_Id (Thread : System.Address) is Thr : constant Thread_Id := To_Thread (Thread).all; - T : Tasking.Task_ID; + T : Tasking.Task_Id; - use type Tasking.Task_ID; + use type Tasking.Task_Id; begin STPO.Lock_RTS; diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index 99b858b223e..ae1ba2ae3ee 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -36,11 +36,6 @@ extern unsigned int largest_move_alignment; /* Declare all functions and types used by gigi. */ -/* See if DECL has an RTL that is indirect via a pseudo-register or a - memory location and replace it with an indirect reference if so. - This improves the debugger's ability to display the value. */ -extern void adjust_decl_rtl (tree); - /* Record the current code position in GNAT_NODE. */ extern void record_code_position (Node_Id); @@ -94,6 +89,13 @@ extern tree gnat_to_gnu_entity (Entity_Id, tree, int); refer to an Ada type. */ extern tree gnat_to_gnu_type (Entity_Id); +/* Add GNU_STMT to the current BLOCK_STMT node. */ +extern void add_stmt (tree); + +/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node. + Get SLOC from Entity_Id. */ +extern void add_decl_stmt (tree, Entity_Id); + /* Given GNAT_ENTITY, elaborate all expressions that are required to be elaborated at the point of its definition, but do nothing else. */ extern void elaborate_entity (Entity_Id); @@ -381,37 +383,17 @@ extern int global_bindings_p (void); is in reverse order (it has to be so for back-end compatibility). */ extern tree getdecls (void); -/* Nonzero if the current level needs to have a BLOCK made. */ -extern int kept_level_p (void); - -/* Enter a new binding level. The input parameter is ignored, but has to be - specified for back-end compatibility. */ -extern void pushlevel (int); - -/* Exit a binding level. - Pop the level off, and restore the state of the identifier-decl mappings - that were in effect when this level was entered. - - If KEEP is nonzero, this level had explicit declarations, so - and create a "block" (a BLOCK node) for the level - to record its declarations and subblocks for symbol table output. - - If FUNCTIONBODY is nonzero, this level is the body of a function, - so create a block as if KEEP were set and also clear out all - label names. - - If REVERSE is nonzero, reverse the order of decls before putting - them into the BLOCK. */ -extern tree poplevel (int, int, int); +/* Enter and exit a new binding level. */ +extern void gnat_pushlevel (void); +extern void gnat_poplevel (void); /* Insert BLOCK at the end of the list of subblocks of the current binding level. This is used when a BIND_EXPR is expanded, to handle the BLOCK node inside the BIND_EXPR. */ extern void insert_block (tree); -/* Set the BLOCK node for the innermost scope - (the one we are currently in). */ -extern void set_block (tree); +/* Return nonzero if the are any variables in the current block. */ +extern int block_has_vars (void); /* Records a ..._DECL node DECL as belonging to the current lexical scope. Returns the ..._DECL node. */ diff --git a/gcc/ada/misc.c b/gcc/ada/misc.c index dca2b0fe9f2..f8fe4de4c19 100644 --- a/gcc/ada/misc.c +++ b/gcc/ada/misc.c @@ -121,6 +121,12 @@ static void gnat_adjust_rli (record_layout_info); #define LANG_HOOKS_HONOR_READONLY true #undef LANG_HOOKS_HASH_TYPES #define LANG_HOOKS_HASH_TYPES false +#undef LANG_HOOKS_PUSHLEVEL +#define LANG_HOOKS_PUSHLEVEL lhd_do_nothing_i +#undef LANG_HOOKS_POPLEVEL +#define LANG_HOOKS_POPLEVEL lhd_do_nothing_iii_return_null_tree +#undef LANG_HOOKS_SET_BLOCK +#define LANG_HOOKS_SET_BLOCK lhd_do_nothing_t #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl #undef LANG_HOOKS_GET_ALIAS_SET @@ -698,66 +704,6 @@ gnat_eh_type_covers (tree a, tree b) return (a == b || a == integer_zero_node); } -/* See if DECL has an RTL that is indirect via a pseudo-register or a - memory location and replace it with an indirect reference if so. - This improves the debugger's ability to display the value. */ - -void -adjust_decl_rtl (tree decl) -{ - tree new_type; - - /* If this decl is already indirect, don't do anything. This should - mean that the decl cannot be indirect, but there's no point in - adding an abort to check that. */ - if (TREE_CODE (decl) != CONST_DECL - && ! DECL_BY_REF_P (decl) - && (GET_CODE (DECL_RTL (decl)) == MEM - && (GET_CODE (XEXP (DECL_RTL (decl), 0)) == MEM - || (GET_CODE (XEXP (DECL_RTL (decl), 0)) == REG - && (REGNO (XEXP (DECL_RTL (decl), 0)) - > LAST_VIRTUAL_REGISTER)))) - /* We can't do this if the reference type's mode is not the same - as the current mode, which means this may not work on mixed 32/64 - bit systems. */ - && (new_type = build_reference_type (TREE_TYPE (decl))) != 0 - && TYPE_MODE (new_type) == GET_MODE (XEXP (DECL_RTL (decl), 0)) - /* If this is a PARM_DECL, we can only do it if DECL_INCOMING_RTL - is also an indirect and of the same mode and if the object is - readonly, the latter condition because we don't want to upset the - handling of CICO_LIST. */ - && (TREE_CODE (decl) != PARM_DECL - || (GET_CODE (DECL_INCOMING_RTL (decl)) == MEM - && (TYPE_MODE (new_type) - == GET_MODE (XEXP (DECL_INCOMING_RTL (decl), 0))) - && TREE_READONLY (decl)))) - { - new_type - = build_qualified_type (new_type, - (TYPE_QUALS (new_type) | TYPE_QUAL_CONST)); - - DECL_POINTS_TO_READONLY_P (decl) = TREE_READONLY (decl); - DECL_BY_REF_P (decl) = 1; - SET_DECL_RTL (decl, XEXP (DECL_RTL (decl), 0)); - TREE_TYPE (decl) = new_type; - DECL_MODE (decl) = TYPE_MODE (new_type); - DECL_ALIGN (decl) = TYPE_ALIGN (new_type); - DECL_SIZE (decl) = TYPE_SIZE (new_type); - - if (TREE_CODE (decl) == PARM_DECL) - set_decl_incoming_rtl (decl, XEXP (DECL_INCOMING_RTL (decl), 0)); - - /* If DECL_INITIAL was set, it should be updated to show that - the decl is initialized to the address of that thing. - Otherwise, just set it to the address of this decl. - It needs to be set so that GCC does not think the decl is - unused. */ - DECL_INITIAL (decl) - = build1 (ADDR_EXPR, new_type, - DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl); - } -} - /* Record the current code position in GNAT_NODE. */ void diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 439645e4bb7..9d034a12dc5 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -34,6 +34,7 @@ with Prj.Com; use Prj.Com; with Prj.Err; use Prj.Err; with Prj.Ext; use Prj.Ext; with Prj.Nmsc; use Prj.Nmsc; +with Snames; with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.HTable; @@ -1847,11 +1848,10 @@ package body Prj.Proc is else declare - Processed_Data : Project_Data := Empty_Project; - Imported : Project_List := Empty_Project_List; - Declaration_Node : Project_Node_Id := Empty_Node; - Name : constant Name_Id := - Name_Of (From_Project_Node); + Processed_Data : Project_Data := Empty_Project; + Imported : Project_List := Empty_Project_List; + Declaration_Node : Project_Node_Id := Empty_Node; + Name : constant Name_Id := Name_Of (From_Project_Node); begin Project := Processed_Projects.Get (Name); @@ -1958,7 +1958,8 @@ package body Prj.Proc is -- If it is an extending project, inherit all packages -- from the extended project that are not explicitely defined - -- or renamed. + -- or renamed. Also inherit the languages, if attribute Languages + -- is not explicitely defined. if Processed_Data.Extends /= No_Project then Processed_Data := Projects.Table (Project); @@ -1971,6 +1972,10 @@ package body Prj.Proc is Element : Package_Element; First : constant Package_Id := Processed_Data.Decl.Packages; + Attribute1 : Variable_Id; + Attribute2 : Variable_Id; + Attr_Value1 : Variable; + Attr_Value2 : Variable; begin while Extended_Pkg /= No_Package loop @@ -1998,6 +2003,52 @@ package body Prj.Proc is Extended_Pkg := Element.Next; end loop; + + -- Check if attribute Languages is declared in the + -- extending project. + + Attribute1 := Processed_Data.Decl.Attributes; + while Attribute1 /= No_Variable loop + Attr_Value1 := Variable_Elements.Table (Attribute1); + exit when Attr_Value1.Name = Snames.Name_Languages; + Attribute1 := Attr_Value1.Next; + end loop; + + if Attribute1 = No_Variable or else + Attr_Value1.Value.Default + then + -- Attribute Languages is not declared in the extending + -- project. Check if it is declared in the project being + -- extended. + + Attribute2 := + Projects.Table (Processed_Data.Extends).Decl.Attributes; + + while Attribute2 /= No_Variable loop + Attr_Value2 := Variable_Elements.Table (Attribute2); + exit when Attr_Value2.Name = Snames.Name_Languages; + Attribute2 := Attr_Value2.Next; + end loop; + + if Attribute2 /= No_Variable and then + not Attr_Value2.Value.Default + then + -- As attribute Languages is declared in the project + -- being extended, copy its value for the extending + -- project. + + if Attribute1 = No_Variable then + Variable_Elements.Increment_Last; + Attribute1 := Variable_Elements.Last; + Attr_Value1.Next := Processed_Data.Decl.Attributes; + Processed_Data.Decl.Attributes := Attribute1; + end if; + + Attr_Value1.Name := Snames.Name_Languages; + Attr_Value1.Value := Attr_Value2.Value; + Variable_Elements.Table (Attribute1) := Attr_Value1; + end if; + end if; end; Projects.Table (Project) := Processed_Data; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index e9a4a4be749..a8336c971db 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -32,6 +32,7 @@ with Fname.UF; use Fname.UF; with Lib; use Lib; with Namet; use Namet; with Sinput; use Sinput; +with Snames; use Snames; with Uname; use Uname; package body Restrict is @@ -353,6 +354,36 @@ package body Restrict is return Restrictions.Set (No_Exception_Handlers); end No_Exception_Handlers_Set; + ---------------------------------- + -- Process_Restriction_Synonyms -- + ---------------------------------- + + -- Note: body of this function must be coordinated with list of + -- renaming declarations in System.Rident. + + function Process_Restriction_Synonyms (Id : Name_Id) return Name_Id is + begin + case Id is + when Name_Boolean_Entry_Barriers => + return Name_Simple_Barriers; + + when Name_Max_Entry_Queue_Depth => + return Name_Max_Entry_Queue_Length; + + when Name_No_Dynamic_Interrupts => + return Name_No_Dynamic_Attachment; + + when Name_No_Requeue => + return Name_No_Requeue_Statements; + + when Name_No_Task_Attributes => + return Name_No_Task_Attributes_Package; + + when others => + return Id; + end case; + end Process_Restriction_Synonyms; + ------------------------ -- Restricted_Profile -- ------------------------ diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 9029620b1f3..0766bb824a7 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -200,6 +200,12 @@ package Restrict is -- handlers are present. This function is called by Gigi when it needs to -- expand an AT END clean up identifier with no exception handler. + function Process_Restriction_Synonyms (Id : Name_Id) return Name_Id; + -- Id is the name of a restriction. If it is one of synonyms that we + -- allow for historical purposes (for list see System.Rident), then + -- the proper official name is returned. Otherwise the argument is + -- returned unchanged. + function Restriction_Active (R : All_Restrictions) return Boolean; pragma Inline (Restriction_Active); -- Determines if a given restriction is active. This call should only be diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 511242909d2..1f8bcab95da 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -489,7 +489,7 @@ package Rtsfind is RE_Abort_Task, -- Ada.Task_Identification RE_Current_Task, -- Ada.Task_Identification - RO_AT_Task_ID, -- Ada.Task_Identification + RO_AT_Task_Id, -- Ada.Task_Identification RO_CA_Time, -- Ada.Calendar @@ -1256,7 +1256,7 @@ package Rtsfind is RE_Task_Procedure_Access, -- System.Tasking - RO_ST_Task_ID, -- System.Tasking + RO_ST_Task_Id, -- System.Tasking RE_Call_Modes, -- System.Tasking RE_Simple_Call, -- System.Tasking @@ -1561,7 +1561,7 @@ package Rtsfind is RE_Abort_Task => Ada_Task_Identification, RE_Current_Task => Ada_Task_Identification, - RO_AT_Task_ID => Ada_Task_Identification, + RO_AT_Task_Id => Ada_Task_Identification, RO_CA_Time => Ada_Calendar, RO_CA_Delay_For => Ada_Calendar_Delays, @@ -2326,7 +2326,7 @@ package Rtsfind is RE_Task_Procedure_Access => System_Tasking, - RO_ST_Task_ID => System_Tasking, + RO_ST_Task_Id => System_Tasking, RE_Call_Modes => System_Tasking, RE_Simple_Call => System_Tasking, diff --git a/gcc/ada/s-asthan-vms.adb b/gcc/ada/s-asthan-vms.adb index 86d04025dbf..7d66ad822c1 100644 --- a/gcc/ada/s-asthan-vms.adb +++ b/gcc/ada/s-asthan-vms.adb @@ -79,11 +79,11 @@ package body System.AST_Handling is -- from all other AST tasks. It is only used by Lock_AST and -- Unlock_AST. - procedure Lock_AST (Self_ID : ST.Task_ID); + procedure Lock_AST (Self_ID : ST.Task_Id); -- Locks out other AST tasks. Preceding a section of code by Lock_AST and -- following it by Unlock_AST creates a critical region. - procedure Unlock_AST (Self_ID : ST.Task_ID); + procedure Unlock_AST (Self_ID : ST.Task_Id); -- Releases lock previously set by call to Lock_AST. -- All nested locks must be released before other tasks competing for the -- tasking lock are released. @@ -92,7 +92,7 @@ package body System.AST_Handling is -- Lock_AST -- -------------- - procedure Lock_AST (Self_ID : ST.Task_ID) is + procedure Lock_AST (Self_ID : ST.Task_Id) is begin STI.Defer_Abort_Nestable (Self_ID); STPO.Write_Lock (AST_Lock'Access, Global_Lock => True); @@ -102,7 +102,7 @@ package body System.AST_Handling is -- Unlock_AST -- ---------------- - procedure Unlock_AST (Self_ID : ST.Task_ID) is + procedure Unlock_AST (Self_ID : ST.Task_Id) is begin STPO.Unlock (AST_Lock'Access, Global_Lock => True); STI.Undefer_Abort_Nestable (Self_ID); @@ -287,7 +287,7 @@ package body System.AST_Handling is Is_Waiting : array (1 .. Max_AST_Servers) of Boolean := (others => False); -- An array of flags showing which AST server tasks are currently waiting - AST_Task_Ids : array (1 .. Max_AST_Servers) of ST.Task_ID; + AST_Task_Ids : array (1 .. Max_AST_Servers) of ST.Task_Id; -- Task Id's of allocated AST server tasks task type AST_Server_Task (Num : Natural) is @@ -344,7 +344,7 @@ package body System.AST_Handling is Taskid : ATID.Task_Id; Entryno : Natural; Param : aliased Long_Integer; - Self_Id : constant ST.Task_ID := ST.Self; + Self_Id : constant ST.Task_Id := ST.Self; pragma Volatile (Param); @@ -421,7 +421,7 @@ package body System.AST_Handling is P : AA := Param'Unrestricted_Access; function To_ST_Task_Id is new Ada.Unchecked_Conversion - (ATID.Task_Id, ST.Task_ID); + (ATID.Task_Id, ST.Task_Id); begin Unlock_AST (Self_Id); @@ -546,7 +546,7 @@ package body System.AST_Handling is -- from which we can obtain the task and entry number information. function To_Address is new Ada.Unchecked_Conversion - (ST.Task_ID, System.Address); + (ST.Task_Id, System.Address); begin System.Machine_Code.Asm diff --git a/gcc/ada/s-inmaop-vms.adb b/gcc/ada/s-inmaop-vms.adb index 2cbfd0eb715..044eac7d037 100644 --- a/gcc/ada/s-inmaop-vms.adb +++ b/gcc/ada/s-inmaop-vms.adb @@ -59,7 +59,7 @@ package body System.Interrupt_Management.Operations is use System.Tasking; use type unsigned_short; - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); package POP renames System.Task_Primitives.Operations; ---------------------------- @@ -122,7 +122,7 @@ package body System.Interrupt_Management.Operations is function Interrupt_Wait (Mask : access Interrupt_Mask) return Interrupt_ID is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; Iosb : IO_Status_Block_Type := (0, 0, 0); Status : Cond_Value_Type; diff --git a/gcc/ada/s-interr-dummy.adb b/gcc/ada/s-interr-dummy.adb index 7dbe33f26a7..0702981ade3 100644 --- a/gcc/ada/s-interr-dummy.adb +++ b/gcc/ada/s-interr-dummy.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2003, Ada Core Technologies -- +-- Copyright (C) 1995-2004, Ada Core Technologies -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -71,7 +71,7 @@ package body System.Interrupts is ----------------------------- procedure Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Int_Ref : System.Address) is @@ -117,7 +117,7 @@ package body System.Interrupts is -- Detach_Interrupt_Entries -- ------------------------------ - procedure Detach_Interrupt_Entries (T : Task_ID) is + procedure Detach_Interrupt_Entries (T : Task_Id) is begin Unimplemented; end Detach_Interrupt_Entries; @@ -278,7 +278,7 @@ package body System.Interrupts is ------------------ function Unblocked_By (Interrupt : Interrupt_ID) - return System.Tasking.Task_ID is + return System.Tasking.Task_Id is begin Unimplemented; return null; diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index 4ee53e00b09..7dff527ae80 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/gcc/ada/s-interr-sigaction.adb @@ -87,13 +87,13 @@ package body System.Interrupts is subtype int is Interfaces.C.int; function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + (Ada.Task_Identification.Task_Id, Task_Id); type Handler_Kind is (Unknown, Task_Entry, Protected_Procedure); type Handler_Desc is record Kind : Handler_Kind := Unknown; - T : Task_ID; + T : Task_Id; E : Task_Entry_Index; H : Parameterless_Handler; Static : Boolean := False; @@ -106,7 +106,7 @@ package body System.Interrupts is type Server_Task_Access is access Server_Task; Attached_Interrupts : array (Interrupt_ID) of Boolean; - Handlers : array (Interrupt_ID) of Task_ID; + Handlers : array (Interrupt_ID) of Task_Id; Descriptors : array (Interrupt_ID) of Handler_Desc; Interrupt_Count : array (Interrupt_ID) of Integer := (others => 0); @@ -150,7 +150,7 @@ package body System.Interrupts is function TISR is new Unchecked_Conversion (Handler_Ptr, isr_address); procedure Signal_Handler (Sig : Interrupt_ID) is - Handler : Task_ID renames Handlers (Sig); + Handler : Task_Id renames Handlers (Sig); begin if Intr_Attach_Reset and then intr_attach (int (Sig), TISR (Signal_Handler'Access)) = FUNC_ERR @@ -215,7 +215,7 @@ package body System.Interrupts is -- Unblocked_By -- ------------------ - function Unblocked_By (Interrupt : Interrupt_ID) return Task_ID is + function Unblocked_By (Interrupt : Interrupt_ID) return Task_Id is begin raise Program_Error; return Null_Task; @@ -532,7 +532,7 @@ package body System.Interrupts is ----------------------------- procedure Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Int_Ref : System.Address) is @@ -580,7 +580,7 @@ package body System.Interrupts is -- Detach_Interrupt_Entries -- ------------------------------ - procedure Detach_Interrupt_Entries (T : Task_ID) is + procedure Detach_Interrupt_Entries (T : Task_Id) is begin for I in Interrupt_ID loop if not Is_Reserved (I) then @@ -631,7 +631,7 @@ package body System.Interrupts is task body Server_Task is Desc : Handler_Desc renames Descriptors (Interrupt); - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Temp : Parameterless_Handler; begin diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index f302ead12e3..9570c2c8367 100644 --- a/gcc/ada/s-interr-vms.adb +++ b/gcc/ada/s-interr-vms.adb @@ -49,7 +49,7 @@ -- rendezvous. with Ada.Task_Identification; --- used for Task_ID type +-- used for Task_Id type with Ada.Exceptions; -- used for Raise_Exception @@ -100,7 +100,7 @@ with System.Storage_Elements; -- Integer_Address with System.Tasking; --- used for Task_ID +-- used for Task_Id -- Task_Entry_Index -- Null_Task -- Self @@ -134,7 +134,7 @@ package body System.Interrupts is package IMOP renames System.Interrupt_Management.Operations; function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + (Ada.Task_Identification.Task_Id, Task_Id); ----------------- -- Local Tasks -- @@ -145,7 +145,7 @@ package body System.Interrupts is -- nizing it. task Interrupt_Manager is - entry Detach_Interrupt_Entries (T : Task_ID); + entry Detach_Interrupt_Entries (T : Task_Id); entry Initialize (Mask : IMNG.Interrupt_Mask); @@ -166,7 +166,7 @@ package body System.Interrupts is Static : Boolean); entry Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID); @@ -197,7 +197,7 @@ package body System.Interrupts is -------------------------------- type Entry_Assoc is record - T : Task_ID; + T : Task_Id; E : Task_Entry_Index; end record; @@ -228,18 +228,18 @@ package body System.Interrupts is pragma Volatile_Components (Ignored); -- True iff the corresponding interrupt is blocked in the process level - Last_Unblocker : constant array (Interrupt_ID'Range) of Task_ID := + Last_Unblocker : constant array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); -- ??? pragma Volatile_Components (Last_Unblocker); -- Holds the ID of the last Task which Unblocked this Interrupt. -- It contains Null_Task if no tasks have ever requested the -- Unblocking operation or the Interrupt is currently Blocked. - Server_ID : array (Interrupt_ID'Range) of Task_ID := + Server_ID : array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); pragma Atomic_Components (Server_ID); - -- Holds the Task_ID of the Server_Task for each interrupt. - -- Task_ID is needed to accomplish locking per Interrupt base. Also + -- Holds the Task_Id of the Server_Task for each interrupt. + -- Task_Id is needed to accomplish locking per Interrupt base. Also -- is needed to decide whether to create a new Server_Task. -- Type and Head, Tail of the list containing Registered Interrupt @@ -523,7 +523,7 @@ package body System.Interrupts is -- already bound. procedure Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Int_Ref : System.Address) is @@ -544,7 +544,7 @@ package body System.Interrupts is -- Detach_Interrupt_Entries -- ------------------------------ - procedure Detach_Interrupt_Entries (T : Task_ID) is + procedure Detach_Interrupt_Entries (T : Task_Id) is begin Interrupt_Manager.Detach_Interrupt_Entries (T); end Detach_Interrupt_Entries; @@ -582,7 +582,7 @@ package body System.Interrupts is ------------------ function Unblocked_By - (Interrupt : Interrupt_ID) return System.Tasking.Task_ID is + (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is begin if Is_Reserved (Interrupt) then Raise_Exception (Program_Error'Identity, "Interrupt" & @@ -708,7 +708,7 @@ package body System.Interrupts is end if; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if Server_ID (Interrupt) = Null_Task then Access_Hold := new Server_Task (Interrupt); @@ -846,7 +846,7 @@ package body System.Interrupts is end Detach_Handler; or accept Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID) do @@ -875,7 +875,7 @@ package body System.Interrupts is T.Interrupt_Entry := True; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if Server_ID (Interrupt) = Null_Task then @@ -888,7 +888,7 @@ package body System.Interrupts is end if; end Bind_Interrupt_To_Entry; - or accept Detach_Interrupt_Entries (T : Task_ID) + or accept Detach_Interrupt_Entries (T : Task_Id) do for J in Interrupt_ID'Range loop if not Is_Reserved (J) then @@ -951,9 +951,9 @@ package body System.Interrupts is ----------------- task body Server_Task is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; Tmp_Handler : Parameterless_Handler; - Tmp_ID : Task_ID; + Tmp_ID : Task_Id; Tmp_Entry_Index : Task_Entry_Index; Intwait_Mask : aliased IMNG.Interrupt_Mask; diff --git a/gcc/ada/s-interr-vxworks.adb b/gcc/ada/s-interr-vxworks.adb index 5898e6d7e26..d0eee62dda3 100644 --- a/gcc/ada/s-interr-vxworks.adb +++ b/gcc/ada/s-interr-vxworks.adb @@ -72,7 +72,7 @@ with System.OS_Interface; use System.OS_Interface; with Interfaces.VxWorks; with Ada.Task_Identification; --- used for Task_ID type +-- used for Task_Id type with Ada.Exceptions; -- used for Raise_Exception @@ -94,7 +94,7 @@ with System.Storage_Elements; -- Integer_Address with System.Tasking; --- used for Task_ID +-- used for Task_Id -- Task_Entry_Index -- Null_Task -- Self @@ -115,10 +115,10 @@ package body System.Interrupts is package POP renames System.Task_Primitives.Operations; function To_Ada is new Unchecked_Conversion - (System.Tasking.Task_ID, Ada.Task_Identification.Task_Id); + (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id); function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + (Ada.Task_Identification.Task_Id, Task_Id); ----------------- -- Local Tasks -- @@ -129,7 +129,7 @@ package body System.Interrupts is -- nizing it. task Interrupt_Manager is - entry Detach_Interrupt_Entries (T : Task_ID); + entry Detach_Interrupt_Entries (T : Task_Id); entry Attach_Handler (New_Handler : Parameterless_Handler; @@ -148,7 +148,7 @@ package body System.Interrupts is Static : Boolean); entry Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID); @@ -168,7 +168,7 @@ package body System.Interrupts is ------------------------------- type Entry_Assoc is record - T : Task_ID; + T : Task_Id; E : Task_Entry_Index; end record; @@ -204,11 +204,11 @@ package body System.Interrupts is Registered_Handler_Head : R_Link := null; Registered_Handler_Tail : R_Link := null; - Server_ID : array (Interrupt_ID) of System.Tasking.Task_ID := + Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id := (others => System.Tasking.Null_Task); pragma Atomic_Components (Server_ID); - -- Holds the Task_ID of the Server_Task for each interrupt / signal. - -- Task_ID is needed to accomplish locking per interrupt base. Also + -- Holds the Task_Id of the Server_Task for each interrupt / signal. + -- Task_Id is needed to accomplish locking per interrupt base. Also -- is needed to determine whether to create a new Server_Task. Semaphore_ID_Map : array @@ -290,7 +290,7 @@ package body System.Interrupts is -- already bound. procedure Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Int_Ref : System.Address) is @@ -365,7 +365,7 @@ package body System.Interrupts is -- Detach_Interrupt_Entries -- ------------------------------ - procedure Detach_Interrupt_Entries (T : Task_ID) is + procedure Detach_Interrupt_Entries (T : Task_Id) is begin Interrupt_Manager.Detach_Interrupt_Entries (T); end Detach_Interrupt_Entries; @@ -727,7 +727,7 @@ package body System.Interrupts is ------------------ function Unblocked_By - (Interrupt : Interrupt_ID) return System.Tasking.Task_ID is + (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is begin Unimplemented ("Unblocked_By"); return Null_Task; @@ -918,7 +918,7 @@ package body System.Interrupts is end if; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if New_Handler /= null and then @@ -992,7 +992,7 @@ package body System.Interrupts is end Detach_Handler; or accept Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID) do @@ -1017,7 +1017,7 @@ package body System.Interrupts is T.Interrupt_Entry := True; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if Server_ID (Interrupt) = Null_Task or else @@ -1034,7 +1034,7 @@ package body System.Interrupts is end Bind_Interrupt_To_Entry; or - accept Detach_Interrupt_Entries (T : Task_ID) do + accept Detach_Interrupt_Entries (T : Task_Id) do for Int in Interrupt_ID'Range loop if not Is_Reserved (Int) then if User_Entry (Int).T = T then @@ -1079,9 +1079,9 @@ package body System.Interrupts is -- Server task for vectored hardware interrupt handling task body Interrupt_Server_Task is - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; Tmp_Handler : Parameterless_Handler; - Tmp_ID : Task_ID; + Tmp_ID : Task_Id; Tmp_Entry_Index : Task_Entry_Index; S : STATUS; diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 41c98ccfb16..39860017d7b 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -55,7 +55,7 @@ -- one Server_Task per interrupt. with Ada.Task_Identification; --- used for Task_ID type +-- used for Task_Id type with Ada.Exceptions; -- used for Raise_Exception @@ -107,7 +107,7 @@ with System.Storage_Elements; -- Integer_Address with System.Tasking; --- used for Task_ID +-- used for Task_Id -- Task_Entry_Index -- Null_Task -- Self @@ -141,7 +141,7 @@ package body System.Interrupts is package IMOP renames System.Interrupt_Management.Operations; function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + (Ada.Task_Identification.Task_Id, Task_Id); ----------------- -- Local Tasks -- @@ -152,7 +152,7 @@ package body System.Interrupts is -- nizing it. task Interrupt_Manager is - entry Detach_Interrupt_Entries (T : Task_ID); + entry Detach_Interrupt_Entries (T : Task_Id); entry Initialize (Mask : IMNG.Interrupt_Mask); @@ -173,7 +173,7 @@ package body System.Interrupts is Static : in Boolean); entry Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID); @@ -204,7 +204,7 @@ package body System.Interrupts is ------------------------------- type Entry_Assoc is record - T : Task_ID; + T : Task_Id; E : Task_Entry_Index; end record; @@ -235,17 +235,17 @@ package body System.Interrupts is -- True iff the corresponding interrupt is blocked in the process level Last_Unblocker : - array (Interrupt_ID'Range) of Task_ID := (others => Null_Task); + array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); pragma Volatile_Components (Last_Unblocker); -- Holds the ID of the last Task which Unblocked this Interrupt. -- It contains Null_Task if no tasks have ever requested the -- Unblocking operation or the Interrupt is currently Blocked. - Server_ID : array (Interrupt_ID'Range) of Task_ID := + Server_ID : array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); pragma Atomic_Components (Server_ID); - -- Holds the Task_ID of the Server_Task for each interrupt. - -- Task_ID is needed to accomplish locking per Interrupt base. Also + -- Holds the Task_Id of the Server_Task for each interrupt. + -- Task_Id is needed to accomplish locking per Interrupt base. Also -- is needed to decide whether to create a new Server_Task. -- Type and Head, Tail of the list containing Registered Interrupt @@ -310,7 +310,7 @@ package body System.Interrupts is -- already bound. procedure Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Int_Ref : System.Address) is @@ -390,7 +390,7 @@ package body System.Interrupts is -- Detach_Interrupt_Entries -- ------------------------------ - procedure Detach_Interrupt_Entries (T : Task_ID) is + procedure Detach_Interrupt_Entries (T : Task_Id) is begin Interrupt_Manager.Detach_Interrupt_Entries (T); end Detach_Interrupt_Entries; @@ -681,7 +681,7 @@ package body System.Interrupts is ------------------ function Unblocked_By - (Interrupt : Interrupt_ID) return System.Tasking.Task_ID + (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is begin if Is_Reserved (Interrupt) then @@ -925,7 +925,7 @@ package body System.Interrupts is end if; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if Server_ID (Interrupt) = Null_Task then @@ -1050,7 +1050,7 @@ package body System.Interrupts is or accept Bind_Interrupt_To_Entry - (T : Task_ID; + (T : Task_Id; E : Task_Entry_Index; Interrupt : Interrupt_ID) do @@ -1078,7 +1078,7 @@ package body System.Interrupts is T.Interrupt_Entry := True; -- Invoke a corresponding Server_Task if not yet created. - -- Place Task_ID info in Server_ID array. + -- Place Task_Id info in Server_ID array. if Server_ID (Interrupt) = Null_Task then -- When a new Server_Task is created, it should have its @@ -1096,7 +1096,7 @@ package body System.Interrupts is end Bind_Interrupt_To_Entry; or - accept Detach_Interrupt_Entries (T : Task_ID) do + accept Detach_Interrupt_Entries (T : Task_Id) do for J in Interrupt_ID'Range loop if not Is_Reserved (J) then if User_Entry (J).T = T then @@ -1249,9 +1249,9 @@ package body System.Interrupts is task body Server_Task is Intwait_Mask : aliased IMNG.Interrupt_Mask; Ret_Interrupt : Interrupt_ID; - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; Tmp_Handler : Parameterless_Handler; - Tmp_ID : Task_ID; + Tmp_ID : Task_Id; Tmp_Entry_Index : Task_Entry_Index; begin diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index 8a97735b5ce..8e7362fd041 100644 --- a/gcc/ada/s-interr.ads +++ b/gcc/ada/s-interr.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -46,7 +46,7 @@ -- tasking implementation to be linked and elaborated. with System.Tasking; --- used for Task_ID +-- used for Task_Id with System.Tasking.Protected_Objects.Entries; -- used for Protection_Entries @@ -131,11 +131,11 @@ package System.Interrupts is -- already attached will raise a Program_Error. procedure Bind_Interrupt_To_Entry - (T : System.Tasking.Task_ID; + (T : System.Tasking.Task_Id; E : System.Tasking.Task_Entry_Index; Int_Ref : System.Address); - procedure Detach_Interrupt_Entries (T : System.Tasking.Task_ID); + procedure Detach_Interrupt_Entries (T : System.Tasking.Task_Id); -- This procedure detaches all the Interrupt Entries bound to a task. ------------------------------- @@ -151,7 +151,7 @@ package System.Interrupts is function Unblocked_By (Interrupt : Interrupt_ID) - return System.Tasking.Task_ID; + return System.Tasking.Task_Id; -- It returns the ID of the last Task which Unblocked this Interrupt. -- It returns Null_Task if no tasks have ever requested the -- Unblocking operation or the Interrupt is currently Blocked. diff --git a/gcc/ada/s-restri.ads b/gcc/ada/s-restri.ads index f6532f3cb38..fc0e3e93776 100644 --- a/gcc/ada/s-restri.ads +++ b/gcc/ada/s-restri.ads @@ -61,7 +61,8 @@ package System.Restrictions is function Tasking_Allowed return Boolean; pragma Inline (Tasking_Allowed); -- Tests to see if tasking operations are allowed by the current - -- restrictions settings. For tasking to be allowed Max_Tasks must + -- restrictions settings. For taskikng to be allowed, No_Tasking + -- must be False, and Max_Tasks must not be set to zero. end System.Restrictions; diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index e3bdbff6876..996b057c192 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -152,13 +152,14 @@ package System.Rident is Not_A_Restriction_Id); - -- Synonyms permitted for historical purposes of compatibility - - -- Boolean_Entry_Barriers synonym for Simple_Barriers - -- Max_Entry_Queue_Depth synonym for Max_Entry_Queue_Length - -- No_Dynamic_Interrupts synonym for No_Dynamic_Attachment - -- No_Requeue synonym for No_Requeue_Statements - -- No_Task_Attributes synonym for No_Task_Attributes_Package + -- Synonyms permitted for historical purposes of compatibility. + -- Must be coordinated with Restrict.Process_Restriction_Synonym. + + Boolean_Entry_Barriers : Restriction_Id renames Simple_Barriers; + Max_Entry_Queue_Depth : Restriction_Id renames Max_Entry_Queue_Length; + No_Dynamic_Interrupts : Restriction_Id renames No_Dynamic_Attachment; + No_Requeue : Restriction_Id renames No_Requeue_Statements; + No_Task_Attributes : Restriction_Id renames No_Task_Attributes_Package; subtype All_Restrictions is Restriction_Id range Simple_Barriers .. Max_Storage_At_Blocking; diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads index 5b34562e355..2b74bec1932 100644 --- a/gcc/ada/s-soflin.ads +++ b/gcc/ada/s-soflin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -221,8 +221,8 @@ package System.Soft_Links is function Get_Exc_Stack_Addr_NT return Address; procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address); - -- Self_ID is a Task_ID, but in the non-tasking case there is no - -- Task_ID type available, so make do with Address. + -- Self_ID is a Task_Id, but in the non-tasking case there is no + -- Task_Id type available, so make do with Address. Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access; Set_Exc_Stack_Addr : Set_Address_Call2 := Set_Exc_Stack_Addr_NT'Access; diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index c2e129c6af6..4bbc43509da 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,7 +62,7 @@ with System.OS_Primitives; -- used for Max_Sensible_Delay with Ada.Task_Identification; --- used for Task_ID type +-- used for Task_Id type with System.Parameters; -- used for Single_Lock @@ -86,9 +86,9 @@ package body System.Tasking.Async_Delays is use System.Traces.Tasking; function To_System is new Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_ID); + (Ada.Task_Identification.Task_Id, Task_Id); - Timer_Server_ID : ST.Task_ID; + Timer_Server_ID : ST.Task_Id; Timer_Attention : Boolean := False; pragma Atomic (Timer_Attention); @@ -214,10 +214,10 @@ package body System.Tasking.Async_Delays is (T : Duration; D : Delay_Block_Access) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Q : Delay_Block_Access; - use type ST.Task_ID; + use type ST.Task_Id; -- for visibility of operator "=" begin @@ -319,7 +319,7 @@ package body System.Tasking.Async_Delays is Yielded : Boolean; Now : Duration; Dequeued : Delay_Block_Access; - Dequeued_Task : Task_ID; + Dequeued_Task : Task_Id; begin Timer_Server_ID := STPO.Self; diff --git a/gcc/ada/s-taasde.ads b/gcc/ada/s-taasde.ads index 1be2904d2aa..21e24f616ae 100644 --- a/gcc/ada/s-taasde.ads +++ b/gcc/ada/s-taasde.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -117,7 +117,7 @@ package System.Tasking.Async_Delays is private type Delay_Block is record - Self_Id : Task_ID; + Self_Id : Task_Id; -- ID of the calling task Level : ATC_Level_Base; diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb index 63b78d05205..97705c1f834 100644 --- a/gcc/ada/s-taenca.adb +++ b/gcc/ada/s-taenca.adb @@ -113,7 +113,7 @@ package body System.Tasking.Entry_Calls is -- If Single_Lock and server is a PO, take RTS_Lock on exit. procedure Unlock_And_Update_Server - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); -- Similar to Unlock_Server, but services entry calls if the -- server is a protected object. @@ -121,7 +121,7 @@ package body System.Tasking.Entry_Calls is -- If Single_Lock and server is a PO, take RTS_Lock on exit. procedure Check_Pending_Actions_For_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); -- This procedure performs priority change of a queued call and -- dequeuing of an entry call when the call is cancelled. @@ -133,7 +133,7 @@ package body System.Tasking.Entry_Calls is -- and to dequeue the call if the call has been aborted. procedure Poll_Base_Priority_Change_At_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); pragma Inline (Poll_Base_Priority_Change_At_Entry_Call); -- A specialized version of Poll_Base_Priority_Change, @@ -146,7 +146,7 @@ package body System.Tasking.Entry_Calls is --------------------- procedure Check_Exception - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is pragma Warnings (Off, Self_ID); @@ -174,7 +174,7 @@ package body System.Tasking.Entry_Calls is ------------------------------------------ procedure Check_Pending_Actions_For_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is begin pragma Assert (Self_ID = Entry_Call.Self); @@ -213,7 +213,7 @@ package body System.Tasking.Entry_Calls is ----------------- procedure Lock_Server (Entry_Call : Entry_Call_Link) is - Test_Task : Task_ID; + Test_Task : Task_Id; Test_PO : Protection_Entries_Access; Ceiling_Violation : Boolean; Failures : Integer := 0; @@ -262,7 +262,7 @@ package body System.Tasking.Entry_Calls is if Ceiling_Violation then declare - Current_Task : constant Task_ID := STPO.Self; + Current_Task : constant Task_Id := STPO.Self; Old_Base_Priority : System.Any_Priority; begin @@ -315,7 +315,7 @@ package body System.Tasking.Entry_Calls is --------------------------------------------- procedure Poll_Base_Priority_Change_At_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is begin if Dynamic_Priority_Support and then Self_ID.Pending_Priority_Change then @@ -377,7 +377,7 @@ package body System.Tasking.Entry_Calls is -------------------- procedure Reset_Priority - (Acceptor : Task_ID; + (Acceptor : Task_Id; Acceptor_Prev_Priority : Rendezvous_Priority) is begin pragma Assert (Acceptor = STPO.Self); @@ -397,7 +397,7 @@ package body System.Tasking.Entry_Calls is procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is Entry_Call : Entry_Call_Link; - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; use type Ada.Exceptions.Exception_Id; @@ -459,11 +459,11 @@ package body System.Tasking.Entry_Calls is ------------------------------ procedure Unlock_And_Update_Server - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is Called_PO : Protection_Entries_Access; - Caller : Task_ID; + Caller : Task_Id; begin if Entry_Call.Called_Task /= null then @@ -503,7 +503,7 @@ package body System.Tasking.Entry_Calls is ------------------- procedure Unlock_Server (Entry_Call : Entry_Call_Link) is - Caller : Task_ID; + Caller : Task_Id; Called_PO : Protection_Entries_Access; begin @@ -543,7 +543,7 @@ package body System.Tasking.Entry_Calls is ------------------------- procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is - Self_Id : constant Task_ID := Entry_Call.Self; + Self_Id : constant Task_Id := Entry_Call.Self; begin -- If this is a conditional call, it should be cancelled when it -- becomes abortable. This is checked in the loop below. @@ -600,7 +600,7 @@ package body System.Tasking.Entry_Calls is Mode : Delay_Modes; Yielded : out Boolean) is - Self_Id : constant Task_ID := Entry_Call.Self; + Self_Id : constant Task_Id := Entry_Call.Self; Timedout : Boolean := False; use type Ada.Exceptions.Exception_Id; @@ -699,7 +699,7 @@ package body System.Tasking.Entry_Calls is -------------------------- procedure Wait_Until_Abortable - (Self_ID : Task_ID; + (Self_ID : Task_Id; Call : Entry_Call_Link) is begin pragma Assert (Self_ID.ATC_Nesting_Level > 0); diff --git a/gcc/ada/s-taenca.ads b/gcc/ada/s-taenca.ads index 15785d837e9..1f81cd9e746 100644 --- a/gcc/ada/s-taenca.ads +++ b/gcc/ada/s-taenca.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,7 +59,7 @@ package System.Tasking.Entry_Calls is -- Check_Exception must be called after calling this procedure. procedure Wait_Until_Abortable - (Self_ID : Task_ID; + (Self_ID : Task_Id; Call : Entry_Call_Link); -- This procedure suspends the calling task until the specified entry -- call is queued abortably or completes. @@ -75,7 +75,7 @@ package System.Tasking.Entry_Calls is -- On return, the call is off-queue and the ATC level is reduced by one. procedure Reset_Priority - (Acceptor : Task_ID; + (Acceptor : Task_Id; Acceptor_Prev_Priority : Rendezvous_Priority); pragma Inline (Reset_Priority); -- Reset the priority of a task completing an accept statement to @@ -83,7 +83,7 @@ package System.Tasking.Entry_Calls is -- Acceptor should always be equal to Self. procedure Check_Exception - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); pragma Inline (Check_Exception); -- Raise any pending exception from the Entry_Call. diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index 365b0d911d3..608d412686e 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/gcc/ada/s-taprop-dummy.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -42,7 +42,7 @@ pragma Polling (Off); with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Error_Reporting; -- used for Shutdown @@ -59,7 +59,7 @@ package body System.Task_Primitives.Operations is -- Stack_Guard -- ----------------- - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is begin null; end Stack_Guard; @@ -68,7 +68,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return OSI.Thread_Id (T.Common.LL.Thread); end Get_Thread_Id; @@ -77,7 +77,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID is + function Self return Task_Id is begin return Null_Task; end Self; @@ -130,7 +130,7 @@ package body System.Task_Primitives.Operations is null; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is begin null; end Write_Lock; @@ -158,7 +158,7 @@ package body System.Task_Primitives.Operations is null; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is begin null; end Unlock; @@ -167,7 +167,7 @@ package body System.Task_Primitives.Operations is -- Sleep -- ----------- - procedure Sleep (Self_ID : Task_ID; Reason : System.Tasking.Task_States) is + procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is begin null; end Sleep; @@ -177,7 +177,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -193,7 +193,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is begin @@ -222,7 +222,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is begin null; end Wakeup; @@ -232,7 +232,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is begin @@ -243,7 +243,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return 0; end Get_Priority; @@ -252,7 +252,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin null; end Enter_Task; @@ -261,7 +261,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -279,7 +279,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin return null; end Register_Foreign_Thread; @@ -288,7 +288,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- ---------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin Succeeded := False; end Initialize_TCB; @@ -298,7 +298,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -311,7 +311,7 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is begin null; end Finalize_TCB; @@ -329,7 +329,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is begin null; end Abort_Task; @@ -350,7 +350,7 @@ package body System.Task_Primitives.Operations is -- Dummy versions. The only currently working versions is for solaris -- (native). - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is begin return True; end Check_Exit; @@ -359,7 +359,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is begin return True; end Check_No_Locks; @@ -368,7 +368,7 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin return null; end Environment_Task; @@ -396,7 +396,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : OSI.Thread_Id) return Boolean is @@ -409,7 +409,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : OSI.Thread_Id) return Boolean is @@ -421,7 +421,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is begin null; end Initialize; diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 1aaf3c26c56..97b3009e674 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -65,7 +65,7 @@ with System.Task_Primitives.Interrupt_Operations; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -106,10 +106,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks @@ -136,7 +136,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -144,11 +144,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does the executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -161,11 +161,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -173,7 +173,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal); - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); ------------------- -- Abort_Handler -- @@ -182,7 +182,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Unreferenced (Sig); - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -211,7 +211,7 @@ package body System.Task_Primitives.Operations is -- bottom of a thread stack, so nothing is needed. -- ??? Check the comment above - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T, On); begin null; @@ -221,7 +221,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- ------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -230,7 +230,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -347,7 +347,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -387,7 +387,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -402,7 +402,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -426,7 +426,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -488,7 +488,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -584,7 +584,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; @@ -622,7 +622,7 @@ package body System.Task_Primitives.Operations is -- scheduling. procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -684,7 +684,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -693,7 +693,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; Specific.Set (Self_ID); @@ -715,7 +715,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -730,7 +730,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -743,7 +743,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -797,7 +797,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -861,13 +861,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -902,7 +902,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is begin -- -- Interrupt Server_Tasks may be waiting on an "event" flag (signal) @@ -921,7 +921,7 @@ package body System.Task_Primitives.Operations is -- Dummy versions. The only currently working versions is for solaris -- (native). - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -931,7 +931,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -941,9 +941,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -969,7 +969,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -985,7 +985,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1000,7 +1000,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1021,7 +1021,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-irix-athread.adb b/gcc/ada/s-taprop-irix-athread.adb index 3c70a347ef2..8c0f95503d8 100644 --- a/gcc/ada/s-taprop-irix-athread.adb +++ b/gcc/ada/s-taprop-irix-athread.adb @@ -59,7 +59,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Program_Info; -- used for Default_Task_Stack @@ -108,8 +108,8 @@ package body System.Task_Primitives.Operations is -- a time; it is used to execute in mutual exclusion from all other tasks. -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -126,9 +126,9 @@ package body System.Task_Primitives.Operations is procedure Initialize_Athread_Library; - function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID); + function To_Task_Id is new Unchecked_Conversion (System.Address, Task_Id); - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); ------------------- -- Stack_Guard -- @@ -138,7 +138,7 @@ package body System.Task_Primitives.Operations is -- bottom of a thread stack, so nothing is needed. -- ??? Check the comment above - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); begin @@ -149,7 +149,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -158,9 +158,9 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID is + function Self return Task_Id is begin - return To_Task_ID (pthread_get_current_ada_tcb); + return To_Task_Id (pthread_get_current_ada_tcb); end Self; --------------------- @@ -285,7 +285,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -323,7 +323,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -337,7 +337,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : ST.Task_ID; + (Self_ID : ST.Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -363,7 +363,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -424,7 +424,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -529,7 +529,7 @@ package body System.Task_Primitives.Operations is ------------ procedure Wakeup - (T : ST.Task_ID; + (T : ST.Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -555,7 +555,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -574,7 +574,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -583,7 +583,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is Result : Interfaces.C.int; begin @@ -612,7 +612,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -630,7 +630,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin return null; end Register_Foreign_Thread; @@ -639,7 +639,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- ---------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -677,7 +677,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -773,12 +773,12 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; begin if not Single_Lock then @@ -811,7 +811,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin Result := @@ -827,7 +827,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -838,7 +838,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -848,9 +848,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -876,7 +876,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -892,7 +892,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -907,9 +907,9 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 6eb6e2ad52a..542bf4b5782 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -67,7 +67,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -117,10 +117,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -138,7 +138,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -146,11 +146,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -163,17 +163,17 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- ----------------------- - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); procedure Abort_Handler (Sig : Signal); -- Signal handler used to implement asynchronous abort. @@ -185,7 +185,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Unreferenced (Sig); - T : constant Task_ID := Self; + T : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -219,7 +219,7 @@ package body System.Task_Primitives.Operations is -- The underlying thread system sets a guard page at the -- bottom of a thread stack, so nothing is needed. - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (On); pragma Unreferenced (T); begin @@ -230,7 +230,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- ------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -239,7 +239,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -370,7 +370,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -409,7 +409,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -424,7 +424,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : ST.Task_ID; + (Self_ID : ST.Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -450,7 +450,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : Task_States; @@ -511,7 +511,7 @@ package body System.Task_Primitives.Operations is -- no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -608,7 +608,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : ST.Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : ST.Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; begin @@ -634,7 +634,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -668,7 +668,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -677,7 +677,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is Result : Interfaces.C.int; function To_Int is new Unchecked_Conversion @@ -715,7 +715,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -730,7 +730,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -743,7 +743,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -781,7 +781,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -915,13 +915,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -956,7 +956,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin @@ -971,7 +971,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -982,7 +982,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -993,9 +993,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1021,7 +1021,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1037,7 +1037,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1052,7 +1052,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1072,7 +1072,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 6ab670f9722..3af3ad3ef95 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -62,7 +62,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with Ada.Exceptions; -- used for Raise_Exception @@ -110,10 +110,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks @@ -150,7 +150,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -158,11 +158,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -175,11 +175,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -199,7 +199,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal) is pragma Unreferenced (signo); - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -248,7 +248,7 @@ package body System.Task_Primitives.Operations is -- The underlying thread system extends the memory (up to 2MB) when needed - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); @@ -260,7 +260,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -269,7 +269,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -348,7 +348,7 @@ package body System.Task_Primitives.Operations is begin if Priority_Ceiling_Emulation then declare - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin if Self_ID.Common.LL.Active_Priority > L.Ceiling then @@ -390,7 +390,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -419,7 +419,7 @@ package body System.Task_Primitives.Operations is begin if Priority_Ceiling_Emulation then declare - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin Result := pthread_mutex_unlock (L.L'Access); @@ -446,7 +446,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -461,7 +461,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -492,7 +492,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -556,7 +556,7 @@ package body System.Task_Primitives.Operations is -- no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -652,7 +652,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; begin @@ -678,7 +678,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -722,7 +722,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -731,7 +731,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; @@ -754,7 +754,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -769,7 +769,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -782,7 +782,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Result : Interfaces.C.int; begin @@ -826,7 +826,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -890,13 +890,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -931,7 +931,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin @@ -946,7 +946,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -957,7 +957,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -968,9 +968,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; ------------------ @@ -978,7 +978,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -994,7 +994,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -1009,7 +1009,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1030,7 +1030,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb index 6276d7f5092..42f77f75f29 100644 --- a/gcc/ada/s-taprop-lynxos.adb +++ b/gcc/ada/s-taprop-lynxos.adb @@ -66,7 +66,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -105,10 +105,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -144,7 +144,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -152,11 +152,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does the current thread have an ATCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -169,11 +169,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -182,7 +182,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal); -- Signal handler used to implement asynchronous abort. - procedure Set_OS_Priority (T : Task_ID; Prio : System.Any_Priority); + procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority); -- This procedure calls the scheduler of the OS to set thread's priority ------------------- @@ -192,7 +192,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Unreferenced (Sig); - T : constant Task_ID := Self; + T : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -226,7 +226,7 @@ package body System.Task_Primitives.Operations is -- Stack_Guard -- ----------------- - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is Stack_Base : constant Address := Get_Stack_Base (T.Common.LL.Thread); Guard_Page_Address : Address; @@ -254,7 +254,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -263,7 +263,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -349,7 +349,7 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is Result : Interfaces.C.int; - T : constant Task_ID := Self; + T : constant Task_Id := Self; begin if Locking_Policy = 'C' then @@ -386,7 +386,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -410,7 +410,7 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access Lock) is Result : Interfaces.C.int; - T : constant Task_ID := Self; + T : constant Task_Id := Self; begin Result := pthread_mutex_unlock (L.Mutex'Access); @@ -432,7 +432,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -446,7 +446,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -475,7 +475,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : Task_States; @@ -554,7 +554,7 @@ package body System.Task_Primitives.Operations is -- the caller is abort-deferred but is holding no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -672,7 +672,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; begin @@ -697,7 +697,7 @@ package body System.Task_Primitives.Operations is -- Set_Priority -- ------------------ - procedure Set_OS_Priority (T : Task_ID; Prio : System.Any_Priority) is + procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority) is Result : Interfaces.C.int; Param : aliased struct_sched_param; @@ -726,7 +726,7 @@ package body System.Task_Primitives.Operations is -- Comments needed for these declarations ??? procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -764,7 +764,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -773,7 +773,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.LWP := lwp_self; @@ -797,7 +797,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -812,7 +812,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -825,7 +825,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- ---------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -885,7 +885,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -970,13 +970,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -1013,7 +1013,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin Result := pthread_kill (T.Common.LL.Thread, @@ -1027,7 +1027,7 @@ package body System.Task_Primitives.Operations is -- Dummy versions - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -1037,7 +1037,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -1047,9 +1047,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1075,7 +1075,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1090,7 +1090,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Unreferenced (T); @@ -1103,7 +1103,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1125,7 +1125,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 1e24de0c6ec..7c9c5922bfe 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -58,7 +58,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -98,8 +98,8 @@ package body System.Task_Primitives.Operations is -- Local Data -- ---------------- - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Single_RTS_Lock : aliased RTS_Lock; -- This is a lock to allow only one thread of control in the RTS at @@ -137,7 +137,7 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. @@ -150,7 +150,7 @@ package body System.Task_Primitives.Operations is return TlsGetValue (TlsIndex) /= System.Null_Address; end Is_Valid_Task; - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Succeeded : BOOL; begin Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id)); @@ -163,11 +163,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ---------------------------------- -- Condition Variable Functions -- @@ -346,7 +346,7 @@ package body System.Task_Primitives.Operations is -- bottom of a thread stack, so nothing is needed. -- ??? Check the comment above - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Warnings (Off, T); pragma Warnings (Off, On); @@ -358,7 +358,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -367,8 +367,8 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID is - Self_Id : constant Task_ID := To_Task_ID (TlsGetValue (TlsIndex)); + function Self return Task_Id is + Self_Id : constant Task_Id := To_Task_Id (TlsGetValue (TlsIndex)); begin if Self_Id = null then return Register_Foreign_Thread (GetCurrentThread); @@ -447,7 +447,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is begin if not Single_Lock then EnterCriticalSection @@ -480,7 +480,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is begin if not Single_Lock then LeaveCriticalSection @@ -493,7 +493,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -524,7 +524,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -585,7 +585,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -659,7 +659,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); begin @@ -692,7 +692,7 @@ package body System.Task_Primitives.Operations is -- scheduling. procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -740,7 +740,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -762,7 +762,7 @@ package body System.Task_Primitives.Operations is -- set in System.Task_Primitives.Operations.Create_Task during the -- thread creation. - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is procedure Init_Float; pragma Import (C, Init_Float, "__gnat_init_float"); -- Properly initializes the FPU for x86 systems. @@ -790,7 +790,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -805,7 +805,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -818,7 +818,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin -- Initialize thread ID to 0, this is needed to detect threads that -- are not yet activated. @@ -839,7 +839,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -909,14 +909,14 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is - Self_ID : Task_ID := T; + procedure Finalize_TCB (T : Task_Id) is + Self_ID : Task_Id := T; Result : DWORD; Succeeded : BOOL; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -960,7 +960,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is pragma Unreferenced (T); begin null; @@ -970,9 +970,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -997,12 +997,12 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is Discard : BOOL; pragma Unreferenced (Discard); begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; if Time_Slice_Val = 0 or else FIFO_Within_Priorities then @@ -1053,7 +1053,7 @@ package body System.Task_Primitives.Operations is -- Dummy versions. The only currently working versions is for solaris -- (native). - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -1064,7 +1064,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -1076,7 +1076,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -1092,7 +1092,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin diff --git a/gcc/ada/s-taprop-os2.adb b/gcc/ada/s-taprop-os2.adb index 924f477bb67..a0e1e4b79d6 100644 --- a/gcc/ada/s-taprop-os2.adb +++ b/gcc/ada/s-taprop-os2.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -57,7 +57,7 @@ with System.Parameters; -- used for Size_Type with System.Tasking; --- used for Task_ID +-- used for Task_Id with System.Parameters; -- used for Size_Type @@ -121,7 +121,7 @@ package body System.Task_Primitives.Operations is -- own TCB_Ptr without destroying the TCB_Ptr of other threads. type Thread_Local_Data is record - Self_ID : Task_ID; -- ID of the current thread + Self_ID : Task_Id; -- ID of the current thread Lock_Prio_Level : Lock_Range; -- Nr of priority changes due to locks -- ... room for expansion here, if we decide to make access to @@ -140,22 +140,22 @@ package body System.Task_Primitives.Operations is -- a time; it is used to execute in mutual exclusion from all other tasks. -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. ----------------------- -- Local Subprograms -- ----------------------- function To_PPVOID is new Unchecked_Conversion (PPTLD, PPVOID); - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); function To_PFNTHREAD is new Unchecked_Conversion (System.Address, PFNTHREAD); function To_MS (D : Duration) return ULONG; procedure Set_Temporary_Priority - (T : in Task_ID; + (T : in Task_Id; New_Priority : in System.Any_Priority); ----------- @@ -199,7 +199,7 @@ package body System.Task_Primitives.Operations is -- bottom of a thread stack, so nothing is needed. -- ??? Check the comment above - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); @@ -211,7 +211,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return OSI.Thread_Id (T.Common.LL.Thread); end Get_Thread_Id; @@ -220,8 +220,8 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID is - Self_ID : Task_ID renames Thread_Local_Data_Ptr.Self_ID; + function Self return Task_Id is + Self_ID : Task_Id renames Thread_Local_Data_Ptr.Self_ID; begin -- Check that the thread local data has been initialized. @@ -287,7 +287,7 @@ package body System.Task_Primitives.Operations is ---------------- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is - Self_ID : constant Task_ID := Thread_Local_Data_Ptr.Self_ID; + Self_ID : constant Task_Id := Thread_Local_Data_Ptr.Self_ID; Old_Priority : constant Any_Priority := Self_ID.Common.LL.Current_Priority; @@ -319,7 +319,7 @@ package body System.Task_Primitives.Operations is (L : access RTS_Lock; Global_Lock : Boolean := False) is - Self_ID : Task_ID; + Self_ID : Task_Id; Old_Priority : Any_Priority; begin @@ -345,7 +345,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is begin if not Single_Lock then @@ -369,7 +369,7 @@ package body System.Task_Primitives.Operations is ------------ procedure Unlock (L : access Lock) is - Self_ID : constant Task_ID := Thread_Local_Data_Ptr.Self_ID; + Self_ID : constant Task_Id := Thread_Local_Data_Ptr.Self_ID; Old_Priority : constant Any_Priority := L.Owner_Priority; begin @@ -397,7 +397,7 @@ package body System.Task_Primitives.Operations is end Unlock; procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is - Self_ID : Task_ID; + Self_ID : Task_Id; Old_Priority : Any_Priority; begin @@ -429,7 +429,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is begin if not Single_Lock then @@ -450,7 +450,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -499,7 +499,7 @@ package body System.Task_Primitives.Operations is -- Self is locked. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -586,7 +586,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -679,7 +679,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); begin @@ -702,7 +702,7 @@ package body System.Task_Primitives.Operations is ---------------------------- procedure Set_Temporary_Priority - (T : Task_ID; + (T : Task_Id; New_Priority : System.Any_Priority) is use Interfaces.C; @@ -743,7 +743,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -758,7 +758,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -767,7 +767,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin -- Initialize thread local data. Must be done first. @@ -799,7 +799,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -817,7 +817,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin return null; end Register_Foreign_Thread; @@ -826,7 +826,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin if DosCreateEventSem (ICS.Null_Ptr, Self_ID.Common.LL.CV'Unchecked_Access, 0, True32) = NO_ERROR @@ -883,7 +883,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -970,11 +970,11 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is - Tmp : Task_ID := T; + procedure Finalize_TCB (T : Task_Id) is + Tmp : Task_Id := T; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin Must_Not_Fail (DosCloseEventSem (T.Common.LL.CV)); @@ -1003,7 +1003,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is pragma Unreferenced (T); begin @@ -1020,7 +1020,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is begin return Check_No_Locks (Self_ID); end Check_Exit; @@ -1029,7 +1029,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is TLD : constant Access_Thread_Local_Data := Thread_Local_Data_Ptr; begin @@ -1041,9 +1041,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1069,7 +1069,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1086,7 +1086,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1102,10 +1102,10 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is Succeeded : Boolean; begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index f5bc6174ccb..297a9bd2cb2 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -71,7 +71,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -111,10 +111,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -150,7 +150,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -158,11 +158,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -175,11 +175,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -189,7 +189,7 @@ package body System.Task_Primitives.Operations is -- Signal handler used to implement asynchronous abort. -- See also comment before body, below. - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); ------------------- -- Abort_Handler -- @@ -218,7 +218,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Warnings (Off, Sig); - T : constant Task_ID := Self; + T : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -250,7 +250,7 @@ package body System.Task_Primitives.Operations is -- Stack_Guard -- ----------------- - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is Stack_Base : constant Address := Get_Stack_Base (T.Common.LL.Thread); Guard_Page_Address : Address; @@ -278,7 +278,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -287,7 +287,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -431,7 +431,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -472,7 +472,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -487,7 +487,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Warnings (Off, Reason); @@ -517,7 +517,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : Task_States; @@ -597,7 +597,7 @@ package body System.Task_Primitives.Operations is -- no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -709,7 +709,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Warnings (Off, Reason); Result : Interfaces.C.int; @@ -737,7 +737,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -770,7 +770,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -779,7 +779,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.LWP := lwp_self; @@ -803,7 +803,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -818,7 +818,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -831,7 +831,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -907,7 +907,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -994,13 +994,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -1038,7 +1038,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin @@ -1053,7 +1053,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Warnings (Off, Self_ID); begin @@ -1064,7 +1064,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Warnings (Off, Self_ID); begin @@ -1075,9 +1075,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1103,7 +1103,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1119,7 +1119,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1134,7 +1134,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1155,7 +1155,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index a264b029693..7011fe0568e 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -68,7 +68,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id -- ATCB components and types with System.Task_Info; @@ -107,16 +107,16 @@ package body System.Task_Primitives.Operations is -- The following are logically constants, but need to be initialized -- at run time. - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. - -- If we use this variable to get the Task_ID, we need the following + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. + -- If we use this variable to get the Task_Id, we need the following -- ATCB_Key only for non-Ada threads. Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks ATCB_Key : aliased thread_key_t; - -- Key used to find the Ada Task_ID associated with a thread, + -- Key used to find the Ada Task_Id associated with a thread, -- at least for C threads unknown to the Ada run-time system. Single_RTS_Lock : aliased RTS_Lock; @@ -213,7 +213,7 @@ package body System.Task_Primitives.Operations is pragma Inline (Record_Wakeup); function Check_Wakeup - (T : Task_ID; + (T : Task_Id; Reason : Task_States) return Boolean; pragma Inline (Check_Wakeup); @@ -229,7 +229,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -237,11 +237,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -254,11 +254,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ------------ -- Checks -- @@ -281,7 +281,7 @@ package body System.Task_Primitives.Operations is pragma Unreferenced (Code); pragma Unreferenced (Context); - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; Old_Set : aliased sigset_t; Result : Interfaces.C.int; @@ -318,7 +318,7 @@ package body System.Task_Primitives.Operations is -- The underlying thread system sets a guard page at the -- bottom of a thread stack, so nothing is needed. - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); @@ -330,7 +330,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -339,7 +339,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : ST.Task_ID) is + procedure Initialize (Environment_Task : ST.Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -429,7 +429,7 @@ package body System.Task_Primitives.Operations is -- Start of processing for Initialize begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- This is done in Enter_Task, but this is too late for the -- Environment Task, since we need to call Self in Check_Locks when @@ -557,7 +557,7 @@ package body System.Task_Primitives.Operations is if Priority_Ceiling_Emulation and then Locking_Policy = 'C' then declare - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; Saved_Priority : System.Any_Priority; begin @@ -603,7 +603,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -636,7 +636,7 @@ package body System.Task_Primitives.Operations is if Priority_Ceiling_Emulation and then Locking_Policy = 'C' then declare - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; begin Result := mutex_unlock (L.L'Access); @@ -663,7 +663,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin @@ -729,14 +729,14 @@ package body System.Task_Primitives.Operations is -- Self --- ----------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; ------------------ -- Set_Priority -- ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -789,7 +789,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -798,7 +798,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is Result : Interfaces.C.int; Proc : processorid_t; -- User processor # Last_Proc : processorid_t; -- Last processor # @@ -846,7 +846,7 @@ package body System.Task_Primitives.Operations is Specific.Set (Self_ID); - -- We need the above code even if we do direct fetch of Task_ID in Self + -- We need the above code even if we do direct fetch of Task_Id in Self -- for the main task on Sun, x86 Solaris and for gcc 2.7.2. Lock_RTS; @@ -866,7 +866,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -881,7 +881,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -894,7 +894,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Result : Interfaces.C.int := 0; begin @@ -936,7 +936,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -1008,13 +1008,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin T.Common.LL.Thread := To_thread_t (0); @@ -1055,7 +1055,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin pragma Assert (T /= Self); @@ -1072,7 +1072,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : Task_States) is Result : Interfaces.C.int; @@ -1178,7 +1178,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -1242,7 +1242,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -1328,7 +1328,7 @@ package body System.Task_Primitives.Operations is ------------ procedure Wakeup - (T : Task_ID; + (T : Task_Id; Reason : Task_States) is Result : Interfaces.C.int; @@ -1350,7 +1350,7 @@ package body System.Task_Primitives.Operations is (L : Lock_Ptr; Level : Lock_Level) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin -- Check that caller is abort-deferred @@ -1374,7 +1374,7 @@ package body System.Task_Primitives.Operations is ---------------- function Check_Lock (L : Lock_Ptr) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; P : Lock_Ptr; begin @@ -1425,7 +1425,7 @@ package body System.Task_Primitives.Operations is ----------------- function Record_Lock (L : Lock_Ptr) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; P : Lock_Ptr; begin @@ -1465,7 +1465,7 @@ package body System.Task_Primitives.Operations is function Check_Sleep (Reason : Task_States) return Boolean is pragma Unreferenced (Reason); - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; P : Lock_Ptr; begin @@ -1510,7 +1510,7 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (Reason); - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; P : Lock_Ptr; begin @@ -1540,10 +1540,10 @@ package body System.Task_Primitives.Operations is ------------------ function Check_Wakeup - (T : Task_ID; + (T : Task_Id; Reason : Task_States) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin -- Is caller holding T's lock? @@ -1566,7 +1566,7 @@ package body System.Task_Primitives.Operations is ------------------ function Check_Unlock (L : Lock_Ptr) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; P : Lock_Ptr; begin @@ -1614,7 +1614,7 @@ package body System.Task_Primitives.Operations is -------------------- function Check_Finalize_Lock (L : Lock_Ptr) return Boolean is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin -- Check that caller is abort-deferred @@ -1637,7 +1637,7 @@ package body System.Task_Primitives.Operations is -- Check_Exit -- ---------------- - function Check_Exit (Self_ID : Task_ID) return Boolean is + function Check_Exit (Self_ID : Task_Id) return Boolean is begin -- Check that caller is just holding Global_Task_Lock -- and no other locks @@ -1669,7 +1669,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : Task_ID) return Boolean is + function Check_No_Locks (Self_ID : Task_Id) return Boolean is begin return Self_ID.Common.LL.Locks = null; end Check_No_Locks; @@ -1678,9 +1678,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1706,7 +1706,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin @@ -1722,7 +1722,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is begin diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index 1fa1c22fa4b..ceccef9553a 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/gcc/ada/s-taprop-tru64.adb @@ -68,7 +68,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id -- ATCB components and types with System.Soft_Links; @@ -108,10 +108,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks @@ -139,7 +139,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -147,11 +147,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -164,11 +164,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -184,7 +184,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Unreferenced (Sig); - T : constant Task_ID := Self; + T : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -219,7 +219,7 @@ package body System.Task_Primitives.Operations is -- The underlying thread system sets a guard page at the -- bottom of a thread stack, so nothing is needed. - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); @@ -231,7 +231,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -240,7 +240,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -334,8 +334,8 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is Result : Interfaces.C.int; - Self_ID : Task_ID; - All_Tasks_Link : Task_ID; + Self_ID : Task_Id; + All_Tasks_Link : Task_Id; Current_Prio : System.Any_Priority; begin @@ -373,7 +373,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -411,7 +411,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -425,7 +425,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -455,7 +455,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -523,7 +523,7 @@ package body System.Task_Primitives.Operations is -- no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -621,7 +621,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; begin @@ -647,7 +647,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -680,7 +680,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -689,7 +689,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; Specific.Set (Self_ID); @@ -711,7 +711,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -726,7 +726,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -739,7 +739,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -793,7 +793,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -920,13 +920,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -961,7 +961,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin Result := @@ -977,7 +977,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -988,7 +988,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -999,9 +999,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1027,7 +1027,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Warnings (Off, T); @@ -1042,7 +1042,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Warnings (Off, T); @@ -1056,7 +1056,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1076,7 +1076,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 5a7739d3abc..b40274ccca7 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -52,7 +52,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -94,10 +94,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Time_Slice_Val : Integer; pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); @@ -117,7 +117,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -125,11 +125,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task @@ -142,26 +142,26 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- ----------------------- - function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID); + function To_Task_Id is new Unchecked_Conversion (System.Address, Task_Id); - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); procedure Timer_Sleep_AST (ID : Address); -- Signal the condition variable when AST fires. procedure Timer_Sleep_AST (ID : Address) is Result : Interfaces.C.int; - Self_ID : constant Task_ID := To_Task_ID (ID); + Self_ID : constant Task_Id := To_Task_Id (ID); begin Self_ID.Common.LL.AST_Pending := False; Result := pthread_cond_signal_int_np (Self_ID.Common.LL.CV'Access); @@ -176,7 +176,7 @@ package body System.Task_Primitives.Operations is -- bottom of a thread stack, so nothing is needed. -- ??? Check the comment above - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); begin @@ -187,7 +187,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -196,7 +196,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -297,8 +297,8 @@ package body System.Task_Primitives.Operations is ---------------- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is - Self_ID : constant Task_ID := Self; - All_Tasks_Link : constant Task_ID := Self.Common.All_Tasks_Link; + Self_ID : constant Task_Id := Self; + All_Tasks_Link : constant Task_Id := Self.Common.All_Tasks_Link; Current_Prio : System.Any_Priority; Result : Interfaces.C.int; @@ -335,7 +335,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -373,7 +373,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -387,7 +387,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -419,7 +419,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -482,7 +482,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -586,7 +586,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; @@ -614,7 +614,7 @@ package body System.Task_Primitives.Operations is ------------------ procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -652,7 +652,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -661,7 +661,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; @@ -684,7 +684,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -699,7 +699,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -712,7 +712,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- ---------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -773,7 +773,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -800,7 +800,7 @@ package body System.Task_Primitives.Operations is -- Since the initial signal mask of a thread is inherited from the -- creator, we need to set our local signal mask mask all signals -- during the creation operation, to make sure the new thread is - -- not disturbed by signals before it has set its own Task_ID. + -- not disturbed by signals before it has set its own Task_Id. Result := pthread_attr_init (Attributes'Access); pragma Assert (Result = 0 or else Result = ENOMEM); @@ -850,13 +850,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); procedure Free is new Unchecked_Deallocation (Exc_Stack_T, Exc_Stack_Ptr_T); @@ -896,7 +896,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is begin -- Interrupt Server_Tasks may be waiting on an event flag @@ -911,7 +911,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -922,7 +922,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -933,9 +933,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -961,7 +961,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Unreferenced (T); @@ -976,7 +976,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Unreferenced (T); @@ -989,9 +989,9 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 8bbbf0e13b0..4ed3d8d925b 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -65,7 +65,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id -- ATCB components and types with Interfaces.C; @@ -100,7 +100,7 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased System.Address := System.Null_Address; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread ATCB_Key_Addr : System.Address := ATCB_Key'Address; pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr"); @@ -108,8 +108,8 @@ package body System.Task_Primitives.Operations is -- implementation. This mechanism is used to minimize impact on other -- targets. - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks @@ -143,11 +143,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does executing thread have a TCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -160,11 +160,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -176,7 +176,7 @@ package body System.Task_Primitives.Operations is procedure Install_Signal_Handlers; -- Install the default signal handlers for the current task - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); ------------------- -- Abort_Handler -- @@ -185,7 +185,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (signo : Signal) is pragma Unreferenced (signo); - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; Result : int; Old_Set : aliased sigset_t; @@ -217,7 +217,7 @@ package body System.Task_Primitives.Operations is -- Stack_Guard -- ----------------- - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is pragma Unreferenced (T); pragma Unreferenced (On); @@ -231,7 +231,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- ------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -240,7 +240,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; ----------------------------- -- Install_Signal_Handlers -- @@ -346,7 +346,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : int; begin @@ -387,7 +387,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : int; begin @@ -401,7 +401,7 @@ package body System.Task_Primitives.Operations is -- Sleep -- ----------- - procedure Sleep (Self_ID : Task_ID; Reason : System.Tasking.Task_States) is + procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : int; @@ -445,7 +445,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -562,7 +562,7 @@ package body System.Task_Primitives.Operations is -- we assume the caller is holding no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -701,7 +701,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : int; @@ -736,7 +736,7 @@ package body System.Task_Primitives.Operations is -- with run-till-blocked scheduling. procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -785,7 +785,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -794,7 +794,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is procedure Init_Float; pragma Import (C, Init_Float, "__gnat_init_float"); -- Properly initializes the FPU for PPC/MIPS systems. @@ -828,7 +828,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -843,7 +843,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -856,7 +856,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- -------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is begin Self_ID.Common.LL.CV := semBCreate (SEM_Q_PRIORITY, SEM_EMPTY); Self_ID.Common.LL.Thread := 0; @@ -877,7 +877,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -958,13 +958,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := (T = Self); procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -1002,7 +1002,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : int; begin @@ -1017,7 +1017,7 @@ package body System.Task_Primitives.Operations is -- Dummy version - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -1028,7 +1028,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin @@ -1039,9 +1039,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1067,7 +1067,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1086,7 +1086,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1104,7 +1104,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is Result : int; begin @@ -1132,7 +1132,7 @@ package body System.Task_Primitives.Operations is end if; end loop; - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index e572a431b5d..dca1c3f8c06 100644 --- a/gcc/ada/s-taprop.ads +++ b/gcc/ada/s-taprop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,7 +38,7 @@ with System.Parameters; -- used for Size_Type with System.Tasking; --- used for Task_ID +-- used for Task_Id with System.OS_Interface; -- used for Thread_Id @@ -49,19 +49,19 @@ package System.Task_Primitives.Operations is package ST renames System.Tasking; package OSI renames System.OS_Interface; - procedure Initialize (Environment_Task : ST.Task_ID); + procedure Initialize (Environment_Task : ST.Task_Id); pragma Inline (Initialize); -- This must be called once, before any other subprograms of this -- package are called. procedure Create_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; Succeeded : out Boolean); pragma Inline (Create_Task); - -- Create a new low-level task with ST.Task_ID T and place other needed + -- Create a new low-level task with ST.Task_Id T and place other needed -- information in the ATCB. -- -- A new thread of control is created, with a stack of at least Stack_Size @@ -69,7 +69,7 @@ package System.Task_Primitives.Operations is -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default -- stack size; this may be effectively "unbounded" on some systems. -- - -- The newly created low-level task is associated with the ST.Task_ID T + -- The newly created low-level task is associated with the ST.Task_Id T -- such that any subsequent call to Self from within the context of the -- low-level task returns T. -- @@ -80,7 +80,7 @@ package System.Task_Primitives.Operations is -- Succeeded is set to true unless creation of the task failed, -- as it may if there are insufficient resources to create another task. - procedure Enter_Task (Self_ID : ST.Task_ID); + procedure Enter_Task (Self_ID : ST.Task_Id); pragma Inline (Enter_Task); -- Initialize data structures specific to the calling task. -- Self must be the ID of the calling task. @@ -96,15 +96,15 @@ package System.Task_Primitives.Operations is -- The effects of further calls to operations defined below -- on the task are undefined thereafter. - function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_ID; + function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id; pragma Inline (New_ATCB); -- Allocate a new ATCB with the specified number of entries. - procedure Initialize_TCB (Self_ID : ST.Task_ID; Succeeded : out Boolean); + procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean); pragma Inline (Initialize_TCB); -- Initialize all fields of the TCB - procedure Finalize_TCB (T : ST.Task_ID); + procedure Finalize_TCB (T : ST.Task_Id); pragma Inline (Finalize_TCB); -- Finalizes Private_Data of ATCB, and then deallocates it. -- This is also responsible for recovering any storage or other resources @@ -113,7 +113,7 @@ package System.Task_Primitives.Operations is -- After it is called there should be no further -- reference to the ATCB that corresponds to T. - procedure Abort_Task (T : ST.Task_ID); + procedure Abort_Task (T : ST.Task_Id); pragma Inline (Abort_Task); -- Abort the task specified by T (the target task). This causes -- the target task to asynchronously raise Abort_Signal if @@ -128,7 +128,7 @@ package System.Task_Primitives.Operations is -- ??? modify GNARL to skip wakeup and always call Abort_Task - function Self return ST.Task_ID; + function Self return ST.Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -172,7 +172,7 @@ package System.Task_Primitives.Operations is procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean); procedure Write_Lock (L : access RTS_Lock; Global_Lock : Boolean := False); - procedure Write_Lock (T : ST.Task_ID); + procedure Write_Lock (T : ST.Task_Id); pragma Inline (Write_Lock); -- Lock a lock object for write access. After this operation returns, -- the calling task holds write permission for the lock object. No other @@ -188,7 +188,7 @@ package System.Task_Primitives.Operations is -- For the operation on RTS_Lock, Global_Lock should be set to True -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock). -- - -- For the operation on ST.Task_ID, the lock is the special lock object + -- For the operation on ST.Task_Id, the lock is the special lock object -- associated with that task's ATCB. This lock has effective ceiling -- priority high enough that it is safe to call by a task with any -- priority in the range System.Priority. It is implicitly initialized @@ -212,7 +212,7 @@ package System.Task_Primitives.Operations is -- Write_Lock. This simplifies the implementation, but reduces the level -- of concurrency that can be achieved. -- - -- Note that Read_Lock is not defined for RT_Lock and ST.Task_ID. + -- Note that Read_Lock is not defined for RT_Lock and ST.Task_Id. -- That is because (1) so far Read_Lock has always been implemented -- the same as Write_Lock, (2) most lock usage inside the RTS involves -- potential write access, and (3) implementations of priority ceiling @@ -220,7 +220,7 @@ package System.Task_Primitives.Operations is procedure Unlock (L : access Lock); procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False); - procedure Unlock (T : ST.Task_ID); + procedure Unlock (T : ST.Task_Id); pragma Inline (Unlock); -- Unlock a locked lock object. -- @@ -295,7 +295,7 @@ package System.Task_Primitives.Operations is -- ones. procedure Set_Priority - (T : ST.Task_ID; + (T : ST.Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False); pragma Inline (Set_Priority); @@ -311,7 +311,7 @@ package System.Task_Primitives.Operations is -- Loss_Of_Inheritance helps the underlying implementation to do it -- right when the OS doesn't. - function Get_Priority (T : ST.Task_ID) return System.Any_Priority; + function Get_Priority (T : ST.Task_Id) return System.Any_Priority; pragma Inline (Get_Priority); -- Returns the priority last set by Set_Priority for this task. @@ -335,7 +335,7 @@ package System.Task_Primitives.Operations is -- Pending priority changes are handled internally. procedure Sleep - (Self_ID : ST.Task_ID; + (Self_ID : ST.Task_Id; Reason : System.Tasking.Task_States); pragma Inline (Sleep); -- Wait until the current task, T, is signaled to wake up. @@ -358,7 +358,7 @@ package System.Task_Primitives.Operations is -- a Wakeup operation is performed for the same task. procedure Timed_Sleep - (Self_ID : ST.Task_ID; + (Self_ID : ST.Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; @@ -367,34 +367,34 @@ package System.Task_Primitives.Operations is -- Combination of Sleep (above) and Timed_Delay procedure Timed_Delay - (Self_ID : ST.Task_ID; + (Self_ID : ST.Task_Id; Time : Duration; Mode : ST.Delay_Modes); -- Implement the semantics of the delay statement. It is assumed that -- the caller is not abort-deferred and does not hold any locks. procedure Wakeup - (T : ST.Task_ID; + (T : ST.Task_Id; Reason : System.Tasking.Task_States); pragma Inline (Wakeup); -- Wake up task T if it is waiting on a Sleep call (of ordinary -- or timed variety), making it ready for execution once again. -- If the task T is not waiting on a Sleep, the operation has no effect. - function Environment_Task return ST.Task_ID; + function Environment_Task return ST.Task_Id; pragma Inline (Environment_Task); -- Return the task ID of the environment task -- Consider putting this into a variable visible directly -- by the rest of the runtime system. ??? - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id; + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id; -- Return the thread id of the specified task function Is_Valid_Task return Boolean; pragma Inline (Is_Valid_Task); -- Does the calling thread have an ATCB? - function Register_Foreign_Thread return ST.Task_ID; + function Register_Foreign_Thread return ST.Task_Id; -- Allocate and initialize a new ATCB for the current thread ----------------------- @@ -439,7 +439,7 @@ package System.Task_Primitives.Operations is -- the guard page ourselves, and the procedure Stack_Guard is provided -- for this purpose. - procedure Stack_Guard (T : ST.Task_ID; On : Boolean); + procedure Stack_Guard (T : ST.Task_Id; On : Boolean); -- Ensure guard page is set if one is needed and the underlying thread -- system does not provide it. The procedure is as follows: -- @@ -467,16 +467,16 @@ package System.Task_Primitives.Operations is -- These interfaces have been added to assist in debugging the -- tasking runtime system. - function Check_Exit (Self_ID : ST.Task_ID) return Boolean; + function Check_Exit (Self_ID : ST.Task_Id) return Boolean; pragma Inline (Check_Exit); -- Check that the current task is holding only Global_Task_Lock. - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean; + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean; pragma Inline (Check_No_Locks); -- Check that current task is holding no locks. function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : OSI.Thread_Id) return Boolean; -- Suspend a specific task when the underlying thread library provides @@ -485,7 +485,7 @@ package System.Task_Primitives.Operations is -- Return True is the operation is successful function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : OSI.Thread_Id) return Boolean; -- Resume a specific task when the underlying thread library provides diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 919db007d5b..6b298a812a6 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -124,13 +124,13 @@ package body System.Tasking.Restricted.Stages is -- Local Subprograms -- ------------------------ - procedure Task_Wrapper (Self_ID : Task_ID); + procedure Task_Wrapper (Self_ID : Task_Id); -- This is the procedure that is called by the GNULL from the -- new context when a task is created. It waits for activation -- and then calls the task body procedure. When the task body -- procedure completes, it terminates the task. - procedure Terminate_Task (Self_ID : Task_ID); + procedure Terminate_Task (Self_ID : Task_Id); -- Terminate the calling task. -- This should only be called by the Task_Wrapper procedure. @@ -210,8 +210,8 @@ package body System.Tasking.Restricted.Stages is -- of the current thread, since it should be at a fixed offset from the -- stack base. - procedure Task_Wrapper (Self_ID : Task_ID) is - ID : Task_ID := Self_ID; + procedure Task_Wrapper (Self_ID : Task_Id) is + ID : Task_Id := Self_ID; pragma Volatile (ID); pragma Warnings (Off, ID); @@ -288,8 +288,8 @@ package body System.Tasking.Restricted.Stages is procedure Activate_Restricted_Tasks (Chain_Access : Activation_Chain_Access) is - Self_ID : constant Task_ID := STPO.Self; - C : Task_ID; + Self_ID : constant Task_Id := STPO.Self; + C : Task_Id; Activate_Prio : System.Any_Priority; Success : Boolean; @@ -377,8 +377,8 @@ package body System.Tasking.Restricted.Stages is -- activator. procedure Complete_Restricted_Activation is - Self_ID : constant Task_ID := STPO.Self; - Activator : constant Task_ID := Self_ID.Common.Activator; + Self_ID : constant Task_Id := STPO.Self; + Activator : constant Task_Id := Self_ID.Common.Activator; begin if Single_Lock then @@ -443,10 +443,10 @@ package body System.Tasking.Restricted.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_ID) + Created_Task : out Task_Id) is - T : Task_ID; - Self_ID : constant Task_ID := STPO.Self; + T : Task_Id; + Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; Success : Boolean; @@ -516,7 +516,7 @@ package body System.Tasking.Restricted.Stages is -- forever, since none of the dependent tasks are expected to terminate procedure Finalize_Global_Tasks is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin pragma Assert (Self_ID = STPO.Environment_Task); @@ -542,7 +542,7 @@ package body System.Tasking.Restricted.Stages is -- Restricted_Terminated -- --------------------------- - function Restricted_Terminated (T : Task_ID) return Boolean is + function Restricted_Terminated (T : Task_Id) return Boolean is begin return T.Common.State = Terminated; end Restricted_Terminated; @@ -551,7 +551,7 @@ package body System.Tasking.Restricted.Stages is -- Terminate_Task -- -------------------- - procedure Terminate_Task (Self_ID : Task_ID) is + procedure Terminate_Task (Self_ID : Task_Id) is begin Self_ID.Common.State := Terminated; end Terminate_Task; diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 56d1f3d6a5d..c2f5471aec6 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -131,7 +131,7 @@ package System.Tasking.Restricted.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_ID); + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- @@ -189,7 +189,7 @@ package System.Tasking.Restricted.Stages is -- If the current task have not completed activation, this should be done -- now in order to wake up the activator (the environment task). - function Restricted_Terminated (T : Task_ID) return Boolean; + function Restricted_Terminated (T : Task_Id) return Boolean; -- Compiler interface only. Do not call from within the RTS. -- This is called by the compiler to implement the 'Terminated attribute. -- diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb index cc431d609e0..f85e229dd70 100644 --- a/gcc/ada/s-tasdeb.adb +++ b/gcc/ada/s-tasdeb.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -48,7 +48,7 @@ package body System.Tasking.Debug is package STPO renames System.Task_Primitives.Operations; function To_Integer is new - Unchecked_Conversion (Task_ID, System.Address); + Unchecked_Conversion (Task_Id, System.Address); type Trace_Flag_Set is array (Character) of Boolean; @@ -80,7 +80,7 @@ package body System.Tasking.Debug is ---------------- procedure List_Tasks is - C : Task_ID; + C : Task_Id; begin C := All_Tasks_List; @@ -103,9 +103,9 @@ package body System.Tasking.Debug is -- Print_Task_Info -- --------------------- - procedure Print_Task_Info (T : Task_ID) is + procedure Print_Task_Info (T : Task_Id) is Entry_Call : Entry_Call_Link; - Parent : Task_ID; + Parent : Task_Id; begin if T = null then @@ -191,7 +191,7 @@ package body System.Tasking.Debug is ---------------------- procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is - C : Task_ID; + C : Task_Id; Dummy : Boolean; pragma Unreferenced (Dummy); @@ -230,7 +230,7 @@ package body System.Tasking.Debug is ----------------------- procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is - C : Task_ID; + C : Task_Id; Dummy : Boolean; pragma Unreferenced (Dummy); @@ -273,10 +273,10 @@ package body System.Tasking.Debug is ----------- procedure Trace - (Self_Id : Task_ID; + (Self_Id : Task_Id; Msg : String; Flag : Character; - Other_Id : Task_ID := null) + Other_Id : Task_Id := null) is begin if Trace_On (Flag) then diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads index fa886e7366f..548df9e269c 100644 --- a/gcc/ada/s-tasdeb.ads +++ b/gcc/ada/s-tasdeb.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -51,7 +51,7 @@ package System.Tasking.Debug is -- Write information about current task, in hexadecimal, as one line, to -- the standard error file. - procedure Print_Task_Info (T : Task_ID); + procedure Print_Task_Info (T : Task_Id); -- Similar to Print_Current_Task, for a given task. procedure Set_User_State (Value : Long_Integer); @@ -66,7 +66,7 @@ package System.Tasking.Debug is -- General GDB support -- ------------------------- - Known_Tasks : array (0 .. 999) of Task_ID; + Known_Tasks : array (0 .. 999) of Task_Id; -- Global array of tasks read by gdb, and updated by -- Create_Task and Finalize_TCB @@ -99,10 +99,10 @@ package System.Tasking.Debug is ------------------------------- procedure Trace - (Self_Id : Task_ID; + (Self_Id : Task_Id; Msg : String; Flag : Character; - Other_Id : Task_ID := null); + Other_Id : Task_Id := null); -- If traces for Flag are enabled, display on Standard_Error a given -- message for the current task. Other_Id is an optional second task id -- to display. diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb index eb87d302dbe..d05654ab66f 100644 --- a/gcc/ada/s-tasini.adb +++ b/gcc/ada/s-tasini.adb @@ -116,7 +116,7 @@ package body System.Tasking.Initialization is -- Get the exception stack for the current task procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address); - -- Self_ID is the Task_ID of the task that gets the exception stack. + -- Self_ID is the Task_Id of the task that gets the exception stack. -- For Self_ID = Null_Address, the current task gets the exception stack. function Get_Machine_State_Addr return Address; @@ -143,7 +143,7 @@ package body System.Tasking.Initialization is -- Local Subprograms -- ------------------------ - procedure Do_Pending_Action (Self_ID : Task_ID); + procedure Do_Pending_Action (Self_ID : Task_Id); -- This is introduced to allow more efficient -- in-line expansion of Undefer_Abort. @@ -171,7 +171,7 @@ package body System.Tasking.Initialization is -- Call only with abort deferred and holding Self_ID locked. - procedure Change_Base_Priority (T : Task_ID) is + procedure Change_Base_Priority (T : Task_Id) is begin if T.Common.Base_Priority /= T.New_Base_Priority then T.Common.Base_Priority := T.New_Base_Priority; @@ -184,7 +184,7 @@ package body System.Tasking.Initialization is ------------------------ function Check_Abort_Status return Integer is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin if Self_ID /= null and then Self_ID.Deferral_Level = 0 and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level @@ -199,7 +199,7 @@ package body System.Tasking.Initialization is -- Defer_Abort -- ----------------- - procedure Defer_Abort (Self_ID : Task_ID) is + procedure Defer_Abort (Self_ID : Task_Id) is begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -240,7 +240,7 @@ package body System.Tasking.Initialization is -- Defer_Abort_Nestable -- -------------------------- - procedure Defer_Abort_Nestable (Self_ID : Task_ID) is + procedure Defer_Abort_Nestable (Self_ID : Task_Id) is begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -261,7 +261,7 @@ package body System.Tasking.Initialization is -------------------- procedure Defer_Abortion is - Self_ID : Task_ID; + Self_ID : Task_Id; begin if No_Abort and then not Dynamic_Priority_Support then @@ -278,7 +278,7 @@ package body System.Tasking.Initialization is -- Call only when holding no locks - procedure Do_Pending_Action (Self_ID : Task_ID) is + procedure Do_Pending_Action (Self_ID : Task_Id) is use type Ada.Exceptions.Exception_Id; begin @@ -353,7 +353,7 @@ package body System.Tasking.Initialization is -- not make any reference to the ATCB after the lock is released. -- See also comments on Terminate_Task and Unlock. - procedure Final_Task_Unlock (Self_ID : Task_ID) is + procedure Final_Task_Unlock (Self_ID : Task_Id) is begin pragma Assert (Self_ID.Global_Task_Lock_Nesting = 1); Unlock (Global_Task_Lock'Access, Global_Lock => True); @@ -364,7 +364,7 @@ package body System.Tasking.Initialization is -------------- procedure Init_RTS is - Self_Id : Task_ID; + Self_Id : Task_Id; begin -- Terminate run time (regular vs restricted) specific initialization @@ -490,8 +490,8 @@ package body System.Tasking.Initialization is -- for this case is done in Terminate_Task. procedure Locked_Abort_To_Level - (Self_ID : Task_ID; - T : Task_ID; + (Self_ID : Task_Id; + T : Task_Id; L : ATC_Level) is begin @@ -590,7 +590,7 @@ package body System.Tasking.Initialization is -- In this version, we check if the task is held too because -- doing this only in Do_Pending_Action is not enough. - procedure Poll_Base_Priority_Change (Self_ID : Task_ID) is + procedure Poll_Base_Priority_Change (Self_ID : Task_Id) is begin if Dynamic_Priority_Support and then Self_ID.Pending_Priority_Change then @@ -636,9 +636,9 @@ package body System.Tasking.Initialization is -- Remove_From_All_Tasks_List -- -------------------------------- - procedure Remove_From_All_Tasks_List (T : Task_ID) is - C : Task_ID; - Previous : Task_ID; + procedure Remove_From_All_Tasks_List (T : Task_Id) is + C : Task_Id; + Previous : Task_Id; begin pragma Debug @@ -670,7 +670,7 @@ package body System.Tasking.Initialization is -- Task_Lock -- --------------- - procedure Task_Lock (Self_ID : Task_ID) is + procedure Task_Lock (Self_ID : Task_Id) is begin Self_ID.Global_Task_Lock_Nesting := Self_ID.Global_Task_Lock_Nesting + 1; @@ -690,7 +690,7 @@ package body System.Tasking.Initialization is --------------- function Task_Name return String is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; begin return Self_Id.Common.Task_Image (1 .. Self_Id.Common.Task_Image_Len); @@ -700,7 +700,7 @@ package body System.Tasking.Initialization is -- Task_Unlock -- ----------------- - procedure Task_Unlock (Self_ID : Task_ID) is + procedure Task_Unlock (Self_ID : Task_Id) is begin pragma Assert (Self_ID.Global_Task_Lock_Nesting > 0); Self_ID.Global_Task_Lock_Nesting := Self_ID.Global_Task_Lock_Nesting - 1; @@ -729,7 +729,7 @@ package body System.Tasking.Initialization is -- The priority change has to occur before abortion. Otherwise, it would -- take effect no earlier than the next abortion completion point. - procedure Undefer_Abort (Self_ID : Task_ID) is + procedure Undefer_Abort (Self_ID : Task_Id) is begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -765,7 +765,7 @@ package body System.Tasking.Initialization is -- as entry to the scope of a region with a finalizer and entry into the -- body of an accept-procedure. - procedure Undefer_Abort_Nestable (Self_ID : Task_ID) is + procedure Undefer_Abort_Nestable (Self_ID : Task_Id) is begin if No_Abort and then not Dynamic_Priority_Support then return; @@ -793,7 +793,7 @@ package body System.Tasking.Initialization is -- to reduce overhead due to multiple calls to Self. procedure Undefer_Abortion is - Self_ID : Task_ID; + Self_ID : Task_Id; begin if No_Abort and then not Dynamic_Priority_Support then @@ -823,7 +823,7 @@ package body System.Tasking.Initialization is procedure Update_Exception (X : AE.Exception_Occurrence := Current_Target_Exception) is - Self_Id : constant Task_ID := Self; + Self_Id : constant Task_Id := Self; use Ada.Exceptions; begin @@ -885,11 +885,11 @@ package body System.Tasking.Initialization is -- if Entry_Call.State >= Was_Abortable. procedure Wakeup_Entry_Caller - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; New_State : Entry_Call_State) is - Caller : constant Task_ID := Entry_Call.Self; + Caller : constant Task_Id := Entry_Call.Self; begin pragma Debug (Debug.Trace @@ -951,7 +951,7 @@ package body System.Tasking.Initialization is end Get_Stack_Info; procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address) is - Me : Task_ID := To_Task_ID (Self_ID); + Me : Task_Id := To_Task_Id (Self_ID); begin if Me = Null_Task then Me := STPO.Self; @@ -989,14 +989,14 @@ package body System.Tasking.Initialization is -- links will be redirected to the real subprogram by elaboration of -- the subprogram body where the real subprogram is declared. - procedure Finalize_Attributes (T : Task_ID) is + procedure Finalize_Attributes (T : Task_Id) is pragma Warnings (Off, T); begin null; end Finalize_Attributes; - procedure Initialize_Attributes (T : Task_ID) is + procedure Initialize_Attributes (T : Task_Id) is pragma Warnings (Off, T); begin diff --git a/gcc/ada/s-tasini.ads b/gcc/ada/s-tasini.ads index 9a52aacd143..e44072c4efd 100644 --- a/gcc/ada/s-tasini.ads +++ b/gcc/ada/s-tasini.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,7 +36,7 @@ package System.Tasking.Initialization is - procedure Remove_From_All_Tasks_List (T : Task_ID); + procedure Remove_From_All_Tasks_List (T : Task_Id); -- Remove T from All_Tasks_List. -- Call this function with RTS_Lock taken. @@ -49,10 +49,10 @@ package System.Tasking.Initialization is -- by the tasking run-time system. -- So far, the only example is support for Ada.Task_Attributes. - type Proc_T is access procedure (T : Task_ID); + type Proc_T is access procedure (T : Task_Id); - procedure Finalize_Attributes (T : Task_ID); - procedure Initialize_Attributes (T : Task_ID); + procedure Finalize_Attributes (T : Task_Id); + procedure Initialize_Attributes (T : Task_Id); Finalize_Attributes_Link : Proc_T := Finalize_Attributes'Access; -- should be called with abortion deferred and T.L write-locked @@ -108,18 +108,18 @@ package System.Tasking.Initialization is -- Non-nestable inline versions -- - procedure Defer_Abort (Self_ID : Task_ID); + procedure Defer_Abort (Self_ID : Task_Id); pragma Inline (Defer_Abort); - procedure Undefer_Abort (Self_ID : Task_ID); + procedure Undefer_Abort (Self_ID : Task_Id); pragma Inline (Undefer_Abort); -- Nestable inline versions -- - procedure Defer_Abort_Nestable (Self_ID : Task_ID); + procedure Defer_Abort_Nestable (Self_ID : Task_Id); pragma Inline (Defer_Abort_Nestable); - procedure Undefer_Abort_Nestable (Self_ID : Task_ID); + procedure Undefer_Abort_Nestable (Self_ID : Task_Id); pragma Inline (Undefer_Abort_Nestable); -- NON-INLINE versions without Self_ID for code generated by the @@ -139,12 +139,12 @@ package System.Tasking.Initialization is -- Change Base Priority -- --------------------------- - procedure Change_Base_Priority (T : Task_ID); + procedure Change_Base_Priority (T : Task_Id); -- Change the base priority of T. -- Has to be called with the affected task's ATCB write-locked. -- May temporariliy release the lock. - procedure Poll_Base_Priority_Change (Self_ID : Task_ID); + procedure Poll_Base_Priority_Change (Self_ID : Task_Id); -- Has to be called with Self_ID's ATCB write-locked. -- May temporariliy release the lock. pragma Inline (Poll_Base_Priority_Change); @@ -153,15 +153,15 @@ package System.Tasking.Initialization is -- Task Lock/Unlock -- ---------------------- - procedure Task_Lock (Self_ID : Task_ID); + procedure Task_Lock (Self_ID : Task_Id); pragma Inline (Task_Lock); - procedure Task_Unlock (Self_ID : Task_ID); + procedure Task_Unlock (Self_ID : Task_Id); pragma Inline (Task_Unlock); -- These are versions of Lock_Task and Unlock_Task created for use -- within the GNARL. - procedure Final_Task_Unlock (Self_ID : Task_ID); + procedure Final_Task_Unlock (Self_ID : Task_Id); -- This version is only for use in Terminate_Task, when the task -- is relinquishing further rights to its own ATCB. -- There is a very interesting potential race condition there, where @@ -171,7 +171,7 @@ package System.Tasking.Initialization is -- See also comments on Terminate_Task and Unlock. procedure Wakeup_Entry_Caller - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; New_State : Entry_Call_State); pragma Inline (Wakeup_Entry_Caller); @@ -195,8 +195,8 @@ package System.Tasking.Initialization is -- if Entry_Call.State >= Was_Abortable. procedure Locked_Abort_To_Level - (Self_ID : Task_ID; - T : Task_ID; + (Self_ID : Task_Id; + T : Task_Id; L : ATC_Level); pragma Inline (Locked_Abort_To_Level); -- Abort a task to a specified ATC level. diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 63d527d20ae..f2ee75c0f13 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -52,28 +52,28 @@ package body System.Tasking is package STPO renames System.Task_Primitives.Operations; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); ---------- -- Self -- ---------- - function Self return Task_ID renames STPO.Self; + function Self return Task_Id renames STPO.Self; --------------------- -- Initialize_ATCB -- --------------------- procedure Initialize_ATCB - (Self_ID : Task_ID; + (Self_ID : Task_Id; Task_Entry_Point : Task_Procedure_Access; Task_Arg : System.Address; - Parent : Task_ID; + Parent : Task_Id; Elaborated : Access_Boolean; Base_Priority : System.Any_Priority; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; - T : in out Task_ID; + T : in out Task_Id; Success : out Boolean) is begin T.Common.State := Unactivated; @@ -146,7 +146,7 @@ package body System.Tasking is begin declare - T : Task_ID; + T : Task_Id; Success : Boolean; Base_Priority : Any_Priority; diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 3e4cf782747..0e08ffd3981 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -109,24 +109,24 @@ package System.Tasking is -- the parent always has a lower serial number than the activator. --------------------------------- - -- Task_ID related definitions -- + -- Task_Id related definitions -- --------------------------------- type Ada_Task_Control_Block; - type Task_ID is access all Ada_Task_Control_Block; + type Task_Id is access all Ada_Task_Control_Block; - Null_Task : constant Task_ID; + Null_Task : constant Task_Id; - type Task_List is array (Positive range <>) of Task_ID; + type Task_List is array (Positive range <>) of Task_Id; - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- This is the compiler interface version of this function. Do not call -- from the run-time system. - function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID); - function To_Address is new Unchecked_Conversion (Task_ID, System.Address); + function To_Task_Id is new Unchecked_Conversion (System.Address, Task_Id); + function To_Address is new Unchecked_Conversion (Task_Id, System.Address); ----------------------- -- Enumeration types -- @@ -301,7 +301,7 @@ package System.Tasking is -- async. select statement does not need to lock anything. type Restricted_Entry_Call_Record is record - Self : Task_ID; + Self : Task_Id; -- ID of the caller Mode : Call_Modes; @@ -388,7 +388,7 @@ package System.Tasking is -- and whether it is terminated. -- Protection: Self.L. - Parent : Task_ID; + Parent : Task_Id; -- The task on which this task depends. -- See also Master_Level and Master_Within. @@ -461,15 +461,15 @@ package System.Tasking is -- per-task structures. -- Protection: Only accessed by Self. - All_Tasks_Link : Task_ID; + All_Tasks_Link : Task_Id; -- Used to link this task to the list of all tasks in the system. -- Protection: RTS_Lock. - Activation_Link : Task_ID; + Activation_Link : Task_Id; -- Used to link this task to a list of tasks to be activated. -- Protection: Only used by Activator. - Activator : Task_ID; + Activator : Task_Id; -- The task that created this task, either by declaring it as a task -- object or by executing a task allocator. -- The value is null iff Self has completed activation. @@ -542,16 +542,16 @@ package System.Tasking is end record; pragma Suppress_Initialization (Restricted_Ada_Task_Control_Block); - Interrupt_Manager_ID : Task_ID; + Interrupt_Manager_ID : Task_Id; -- This task ID is declared here to break circular dependencies. - -- Also declare Interrupt_Manager_ID after Task_ID is known, to avoid + -- Also declare Interrupt_Manager_ID after Task_Id is known, to avoid -- generating unneeded finalization code. ----------------------- -- List of all Tasks -- ----------------------- - All_Tasks_List : Task_ID; + All_Tasks_List : Task_Id; -- Global linked list of all tasks. ------------------------------------------ @@ -633,7 +633,7 @@ package System.Tasking is ---------------------------------- type Entry_Call_Record is record - Self : Task_ID; + Self : Task_Id; -- ID of the caller Mode : Call_Modes; @@ -679,7 +679,7 @@ package System.Tasking is -- They are gathered together to allow for compilers that lay records -- out contiguously, to allow for such packing. - Called_Task : Task_ID; + Called_Task : Task_Id; pragma Atomic (Called_Task); -- Use for task entry calls. -- The value is null if the call record is not in use. @@ -953,25 +953,25 @@ package System.Tasking is --------------------- procedure Initialize_ATCB - (Self_ID : Task_ID; + (Self_ID : Task_Id; Task_Entry_Point : Task_Procedure_Access; Task_Arg : System.Address; - Parent : Task_ID; + Parent : Task_Id; Elaborated : Access_Boolean; Base_Priority : System.Any_Priority; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; - T : in out Task_ID; + T : in out Task_Id; Success : out Boolean); -- Initialize fields of a TCB and link into global TCB structures -- Call this only with abort deferred and holding RTS_Lock. private - Null_Task : constant Task_ID := null; + Null_Task : constant Task_Id := null; type Activation_Chain is record - T_ID : Task_ID; + T_ID : Task_Id; end record; pragma Volatile (Activation_Chain); diff --git a/gcc/ada/s-tasque.adb b/gcc/ada/s-tasque.adb index e96bfeca061..5158b9c4044 100644 --- a/gcc/ada/s-tasque.adb +++ b/gcc/ada/s-tasque.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -60,7 +60,7 @@ package body System.Tasking.Queuing is Priority_Queuing : constant Boolean := Queuing_Policy = 'P'; procedure Send_Program_Error - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); -- Raise Program_Error in the caller of the specified entry call @@ -74,7 +74,7 @@ package body System.Tasking.Queuing is ----------------------------- procedure Broadcast_Program_Error - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Protection_Entries_Access; Pending_Call : Entry_Call_Link; RTS_Locked : Boolean := False) @@ -469,7 +469,7 @@ package body System.Tasking.Queuing is -- queuing policy being used. procedure Select_Protected_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Protection_Entries_Access; Call : out Entry_Call_Link) is @@ -547,7 +547,7 @@ package body System.Tasking.Queuing is -- being used. procedure Select_Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; Open_Accepts : Accept_List_Access; Call : out Entry_Call_Link; Selection : out Select_Index; @@ -618,10 +618,10 @@ package body System.Tasking.Queuing is ------------------------ procedure Send_Program_Error - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is - Caller : Task_ID; + Caller : Task_Id; begin Caller := Entry_Call.Self; Entry_Call.Exception_To_Raise := Program_Error'Identity; diff --git a/gcc/ada/s-tasque.ads b/gcc/ada/s-tasque.ads index 91538a2849f..170a2972373 100644 --- a/gcc/ada/s-tasque.ads +++ b/gcc/ada/s-tasque.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,7 +38,7 @@ package System.Tasking.Queuing is package POE renames System.Tasking.Protected_Objects.Entries; procedure Broadcast_Program_Error - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : POE.Protection_Entries_Access; Pending_Call : Entry_Call_Link; RTS_Locked : Boolean := False); @@ -71,7 +71,7 @@ package System.Tasking.Queuing is -- Return number of calls on the waiting queue of E procedure Select_Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; Open_Accepts : Accept_List_Access; Call : out Entry_Call_Link; Selection : out Select_Index; @@ -82,7 +82,7 @@ package System.Tasking.Queuing is -- Open_Alternative will be True if there were any open alternatives procedure Select_Protected_Entry_Call - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : POE.Protection_Entries_Access; Call : out Entry_Call_Link); -- Select an entry of a protected object diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 8d4c5e23247..75eecc6755a 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -130,10 +130,10 @@ package body System.Tasking.Rendezvous is -- Local Subprograms -- ----------------------- - procedure Local_Defer_Abort (Self_Id : Task_ID) renames + procedure Local_Defer_Abort (Self_Id : Task_Id) renames System.Tasking.Initialization.Defer_Abort_Nestable; - procedure Local_Undefer_Abort (Self_Id : Task_ID) renames + procedure Local_Undefer_Abort (Self_Id : Task_Id) renames System.Tasking.Initialization.Undefer_Abort_Nestable; -- Florist defers abort around critical sections that @@ -147,12 +147,12 @@ package body System.Tasking.Rendezvous is -- an earlier abort deferral. Thus, for debugging it may be -- wise to modify the above renamings to the non-nestable forms. - procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_ID); + procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id); pragma Inline (Boost_Priority); -- Call this only with abort deferred and holding lock of Acceptor. procedure Call_Synchronous - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Mode : Call_Modes; @@ -163,7 +163,7 @@ package body System.Tasking.Rendezvous is procedure Setup_For_Rendezvous_With_Body (Entry_Call : Entry_Call_Link; - Acceptor : Task_ID); + Acceptor : Task_Id); pragma Inline (Setup_For_Rendezvous_With_Body); -- Call this only with abort deferred and holding lock of Acceptor. -- When a rendezvous selected (ready for rendezvous) we need to save @@ -171,7 +171,7 @@ package body System.Tasking.Rendezvous is -- this call not Abortable (Cancellable) since the rendezvous has -- already been started. - procedure Wait_For_Call (Self_Id : Task_ID); + procedure Wait_For_Call (Self_Id : Task_Id); pragma Inline (Wait_For_Call); -- Call this only with abort deferred and holding lock of Self_Id. -- An accepting task goes into Sleep by calling this routine @@ -186,8 +186,8 @@ package body System.Tasking.Rendezvous is (E : Task_Entry_Index; Uninterpreted_Data : out System.Address) is - Self_Id : constant Task_ID := STPO.Self; - Caller : Task_ID := null; + Self_Id : constant Task_Id := STPO.Self; + Caller : Task_Id := null; Open_Accepts : aliased Accept_List (1 .. 1); Entry_Call : Entry_Call_Link; @@ -277,8 +277,8 @@ package body System.Tasking.Rendezvous is -------------------- procedure Accept_Trivial (E : Task_Entry_Index) is - Self_Id : constant Task_ID := STPO.Self; - Caller : Task_ID := null; + Self_Id : constant Task_Id := STPO.Self; + Caller : Task_Id := null; Open_Accepts : aliased Accept_List (1 .. 1); Entry_Call : Entry_Call_Link; @@ -366,8 +366,8 @@ package body System.Tasking.Rendezvous is -- Boost_Priority -- -------------------- - procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_ID) is - Caller : constant Task_ID := Call.Self; + procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id) is + Caller : constant Task_Id := Call.Self; Caller_Prio : constant System.Any_Priority := Get_Priority (Caller); Acceptor_Prio : constant System.Any_Priority := Get_Priority (Acceptor); @@ -386,7 +386,7 @@ package body System.Tasking.Rendezvous is ----------------- procedure Call_Simple - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address) is @@ -401,13 +401,13 @@ package body System.Tasking.Rendezvous is ---------------------- procedure Call_Synchronous - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Mode : Call_Modes; Rendezvous_Successful : out Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Level : ATC_Level; Entry_Call : Entry_Call_Link; @@ -490,9 +490,9 @@ package body System.Tasking.Rendezvous is -- Callable -- -------------- - function Callable (T : Task_ID) return Boolean is + function Callable (T : Task_Id) return Boolean is Result : Boolean; - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; begin Initialization.Defer_Abort (Self_Id); @@ -538,9 +538,9 @@ package body System.Tasking.Rendezvous is procedure Exceptional_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link := Self_Id.Common.Call; - Caller : Task_ID; + Caller : Task_Id; Called_PO : STPE.Protection_Entries_Access; Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex; @@ -732,7 +732,7 @@ package body System.Tasking.Rendezvous is procedure Requeue_Protected_To_Task_Entry (Object : STPE.Protection_Entries_Access; - Acceptor : Task_ID; + Acceptor : Task_Id; E : Task_Entry_Index; With_Abort : Boolean) is @@ -752,11 +752,11 @@ package body System.Tasking.Rendezvous is ------------------------ procedure Requeue_Task_Entry - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; With_Abort : Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call; begin @@ -778,10 +778,10 @@ package body System.Tasking.Rendezvous is Uninterpreted_Data : out System.Address; Index : out Select_Index) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; Treatment : Select_Treatment; - Caller : Task_ID; + Caller : Task_Id; Selection : Select_Index; Open_Alternative : Boolean; @@ -1035,7 +1035,7 @@ package body System.Tasking.Rendezvous is procedure Setup_For_Rendezvous_With_Body (Entry_Call : Entry_Call_Link; - Acceptor : Task_ID) is + Acceptor : Task_Id) is begin Entry_Call.Acceptor_Prev_Call := Acceptor.Common.Call; Acceptor.Common.Call := Entry_Call; @@ -1052,7 +1052,7 @@ package body System.Tasking.Rendezvous is ---------------- function Task_Count (E : Task_Entry_Index) return Natural is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Return_Count : Natural; begin @@ -1079,15 +1079,15 @@ package body System.Tasking.Rendezvous is ---------------------- function Task_Do_Or_Queue - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; With_Abort : Boolean) return Boolean is E : constant Task_Entry_Index := Task_Entry_Index (Entry_Call.E); Old_State : constant Entry_Call_State := Entry_Call.State; - Acceptor : constant Task_ID := Entry_Call.Called_Task; - Parent : constant Task_ID := Acceptor.Common.Parent; + Acceptor : constant Task_Id := Entry_Call.Called_Task; + Parent : constant Task_Id := Acceptor.Common.Parent; Parent_Locked : Boolean := False; Null_Body : Boolean; @@ -1299,13 +1299,13 @@ package body System.Tasking.Rendezvous is --------------------- procedure Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Mode : Call_Modes; Rendezvous_Successful : out Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; begin @@ -1391,8 +1391,8 @@ package body System.Tasking.Rendezvous is -- Task_Entry_Caller -- ----------------------- - function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_ID is - Self_Id : constant Task_ID := STPO.Self; + function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id is + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; begin @@ -1418,10 +1418,10 @@ package body System.Tasking.Rendezvous is Mode : Delay_Modes; Index : out Select_Index) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Treatment : Select_Treatment; Entry_Call : Entry_Call_Link; - Caller : Task_ID; + Caller : Task_Id; Selection : Select_Index; Open_Alternative : Boolean; Timedout : Boolean := False; @@ -1655,14 +1655,14 @@ package body System.Tasking.Rendezvous is --------------------------- procedure Timed_Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Timeout : Duration; Mode : Delay_Modes; Rendezvous_Successful : out Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Level : ATC_Level; Entry_Call : Entry_Call_Link; Yielded : Boolean; @@ -1747,7 +1747,7 @@ package body System.Tasking.Rendezvous is -- Wait_For_Call -- ------------------- - procedure Wait_For_Call (Self_Id : Task_ID) is + procedure Wait_For_Call (Self_Id : Task_Id) is begin -- Try to remove calls to Sleep in the loop below by letting the caller -- a chance of getting ready immediately, using Unlock & Yield. diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads index 5cf8d733577..4b82bb3ff67 100644 --- a/gcc/ada/s-tasren.ads +++ b/gcc/ada/s-tasren.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -45,7 +45,7 @@ package System.Tasking.Rendezvous is package STPE renames System.Tasking.Protected_Objects.Entries; procedure Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Mode : Call_Modes; @@ -61,7 +61,7 @@ package System.Tasking.Rendezvous is -- Rendezvous_Successful is set to True on return if the call was serviced. procedure Timed_Task_Entry_Call - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address; Timeout : Duration; @@ -74,7 +74,7 @@ package System.Tasking.Rendezvous is -- Mode determines whether the delay is relative or absolute. procedure Call_Simple - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; Uninterpreted_Data : System.Address); -- Simple entry call. @@ -100,7 +100,7 @@ package System.Tasking.Rendezvous is -- See Exp_Ch9.Expand_N_Asynchronous_Select for code expansion. procedure Requeue_Task_Entry - (Acceptor : Task_ID; + (Acceptor : Task_Id; E : Task_Entry_Index; With_Abort : Boolean); -- Requeue from a task entry to a task entry. @@ -136,7 +136,7 @@ package System.Tasking.Rendezvous is procedure Requeue_Protected_To_Task_Entry (Object : STPE.Protection_Entries_Access; - Acceptor : Task_ID; + Acceptor : Task_Id; E : Task_Entry_Index; With_Abort : Boolean); -- Requeue from a protected entry to a task entry. @@ -294,7 +294,7 @@ package System.Tasking.Rendezvous is -- Return number of tasks waiting on the entry E (of current task) -- Compiler interface only. Do not call from within the RTS. - function Callable (T : Task_ID) return Boolean; + function Callable (T : Task_Id) return Boolean; -- Return T'Callable -- Compiler interface. Do not call from within the RTS, except for body of -- Ada.Task_Identification. @@ -302,7 +302,7 @@ package System.Tasking.Rendezvous is type Task_Entry_Nesting_Depth is new Task_Entry_Index range 0 .. Max_Task_Entry; - function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_ID; + function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id; -- Return E'Caller. This will only work if called from within an -- accept statement that is handling E, as required by the LRM (C.7.1(14)). -- Compiler interface only. Do not call from within the RTS. @@ -318,7 +318,7 @@ package System.Tasking.Rendezvous is -- For internal use only: function Task_Do_Or_Queue - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; With_Abort : Boolean) return Boolean; -- Call this only with abort deferred and holding no locks, except diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index cc946115a8e..e3b4c951b3a 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -130,40 +130,40 @@ package body System.Tasking.Stages is -- Local Subprograms -- ----------------------- - procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_ID); + procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id); -- This procedure outputs the task specific message for exception -- tracing purposes. - procedure Task_Wrapper (Self_ID : Task_ID); + procedure Task_Wrapper (Self_ID : Task_Id); -- This is the procedure that is called by the GNULL from the -- new context when a task is created. It waits for activation -- and then calls the task body procedure. When the task body -- procedure completes, it terminates the task. - procedure Vulnerable_Complete_Task (Self_ID : Task_ID); + procedure Vulnerable_Complete_Task (Self_ID : Task_Id); -- Complete the calling task. -- This procedure must be called with abort deferred. -- It should only be called by Complete_Task and -- Finalizate_Global_Tasks (for the environment task). - procedure Vulnerable_Complete_Master (Self_ID : Task_ID); + procedure Vulnerable_Complete_Master (Self_ID : Task_Id); -- Complete the current master of the calling task. -- This procedure must be called with abort deferred. -- It should only be called by Vulnerable_Complete_Task and -- Complete_Master. - procedure Vulnerable_Complete_Activation (Self_ID : Task_ID); + procedure Vulnerable_Complete_Activation (Self_ID : Task_Id); -- Signal to Self_ID's activator that Self_ID has -- completed activation. -- -- Call this procedure with abort deferred. - procedure Abort_Dependents (Self_ID : Task_ID); + procedure Abort_Dependents (Self_ID : Task_Id); -- Abort all the direct dependents of Self at its current master -- nesting level, plus all of their dependents, transitively. -- RTS_Lock should be locked by the caller. - procedure Vulnerable_Free_Task (T : Task_ID); + procedure Vulnerable_Free_Task (T : Task_Id); -- Recover all runtime system storage associated with the task T. -- This should only be called after T has terminated and will no -- longer be referenced. @@ -181,9 +181,9 @@ package body System.Tasking.Stages is -- Abort_Dependents -- ---------------------- - procedure Abort_Dependents (Self_ID : Task_ID) is - C : Task_ID; - P : Task_ID; + procedure Abort_Dependents (Self_ID : Task_Id) is + C : Task_Id; + P : Task_Id; begin C := All_Tasks_List; @@ -251,10 +251,10 @@ package body System.Tasking.Stages is -- operation is done in a separate pass over the activation chain. procedure Activate_Tasks (Chain_Access : Activation_Chain_Access) is - Self_ID : constant Task_ID := STPO.Self; - P : Task_ID; - C : Task_ID; - Next_C, Last_C : Task_ID; + Self_ID : constant Task_Id := STPO.Self; + P : Task_Id; + C : Task_Id; + Next_C, Last_C : Task_Id; Activate_Prio : System.Any_Priority; Success : Boolean; All_Elaborated : Boolean := True; @@ -426,7 +426,7 @@ package body System.Tasking.Stages is ------------------------- procedure Complete_Activation is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin Initialization.Defer_Abort_Nestable (Self_ID); @@ -455,7 +455,7 @@ package body System.Tasking.Stages is --------------------- procedure Complete_Master is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin pragma Assert (Self_ID.Deferral_Level > 0); @@ -470,7 +470,7 @@ package body System.Tasking.Stages is -- See comments on Vulnerable_Complete_Task for details procedure Complete_Task is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin pragma Assert (Self_ID.Deferral_Level > 0); @@ -498,10 +498,10 @@ package body System.Tasking.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_ID) + Created_Task : out Task_Id) is - T, P : Task_ID; - Self_ID : constant Task_ID := STPO.Self; + T, P : Task_Id; + Self_ID : constant Task_Id := STPO.Self; Success : Boolean; Base_Priority : System.Any_Priority; Len : Natural; @@ -639,7 +639,7 @@ package body System.Tasking.Stages is ------------------ procedure Enter_Master is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin Self_ID.Master_Within := Self_ID.Master_Within + 1; @@ -652,10 +652,10 @@ package body System.Tasking.Stages is -- See procedure Close_Entries for the general case. procedure Expunge_Unactivated_Tasks (Chain : in out Activation_Chain) is - Self_ID : constant Task_ID := STPO.Self; - C : Task_ID; + Self_ID : constant Task_Id := STPO.Self; + C : Task_Id; Call : Entry_Call_Link; - Temp : Task_ID; + Temp : Task_Id; begin pragma Debug @@ -714,7 +714,7 @@ package body System.Tasking.Stages is -- using the global finalization chain. procedure Finalize_Global_Tasks is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; Ignore : Boolean; begin @@ -813,8 +813,8 @@ package body System.Tasking.Stages is -- Free_Task -- --------------- - procedure Free_Task (T : Task_ID) is - Self_Id : constant Task_ID := Self; + procedure Free_Task (T : Task_Id) is + Self_Id : constant Task_Id := Self; begin if T.Common.State = Terminated then @@ -851,7 +851,7 @@ package body System.Tasking.Stages is -- data. Task finalization is done by Complete_Task, which is called from -- an at-end handler that the compiler generates. - procedure Task_Wrapper (Self_ID : Task_ID) is + procedure Task_Wrapper (Self_ID : Task_Id) is use type System.Parameters.Size_Type; use type SSE.Storage_Offset; use System.Standard_Library; @@ -973,8 +973,8 @@ package body System.Tasking.Stages is -- overwriting the data of the new task that reused the ATCB! To solve -- this problem, we introduced the new operation Final_Task_Unlock. - procedure Terminate_Task (Self_ID : Task_ID) is - Environment_Task : constant Task_ID := STPO.Environment_Task; + procedure Terminate_Task (Self_ID : Task_Id) is + Environment_Task : constant Task_Id := STPO.Environment_Task; Master_of_Task : Integer; begin @@ -1045,8 +1045,8 @@ package body System.Tasking.Stages is -- Terminated -- ---------------- - function Terminated (T : Task_ID) return Boolean is - Self_ID : constant Task_ID := STPO.Self; + function Terminated (T : Task_Id) return Boolean is + Self_ID : constant Task_Id := STPO.Self; Result : Boolean; begin @@ -1072,7 +1072,7 @@ package body System.Tasking.Stages is -- Trace_Unhandled_Exception_In_Task -- ---------------------------------------- - procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_ID) is + procedure Trace_Unhandled_Exception_In_Task (Self_Id : Task_Id) is procedure To_Stderr (S : String); pragma Import (Ada, To_Stderr, "__gnat_to_stderr"); @@ -1081,7 +1081,7 @@ package body System.Tasking.Stages is use System.Standard_Library; function To_Address is new - Unchecked_Conversion (Task_ID, System.Address); + Unchecked_Conversion (Task_Id, System.Address); function Tailored_Exception_Information (E : Exception_Occurrence) return String; @@ -1121,8 +1121,8 @@ package body System.Tasking.Stages is -- ordering policy, since the activated task must be created after the -- activator. - procedure Vulnerable_Complete_Activation (Self_ID : Task_ID) is - Activator : constant Task_ID := Self_ID.Common.Activator; + procedure Vulnerable_Complete_Activation (Self_ID : Task_Id) is + Activator : constant Task_Id := Self_ID.Common.Activator; begin pragma Debug (Debug.Trace (Self_ID, "V_Complete_Activation", 'C')); @@ -1175,13 +1175,13 @@ package body System.Tasking.Stages is -- Vulnerable_Complete_Master -- -------------------------------- - procedure Vulnerable_Complete_Master (Self_ID : Task_ID) is - C : Task_ID; - P : Task_ID; + procedure Vulnerable_Complete_Master (Self_ID : Task_Id) is + C : Task_Id; + P : Task_Id; CM : constant Master_Level := Self_ID.Master_Within; - T : aliased Task_ID; + T : aliased Task_Id; - To_Be_Freed : Task_ID; + To_Be_Freed : Task_Id; -- This is a list of ATCBs to be freed, after we have released -- all RTS locks. This is necessary because of the locking order -- rules, since the storage manager uses Global_Task_Lock. @@ -1478,7 +1478,7 @@ package body System.Tasking.Stages is -- Be sure to update this value when changing -- Interrupt_Manager specs. - type Param_Type is access all Task_ID; + type Param_Type is access all Task_Id; Param : aliased Param_Type := T'Access; @@ -1546,7 +1546,7 @@ package body System.Tasking.Stages is -- to test Self_ID.Common.Activator. That value should only be read and -- modified by Self. - procedure Vulnerable_Complete_Task (Self_ID : Task_ID) is + procedure Vulnerable_Complete_Task (Self_ID : Task_Id) is begin pragma Assert (Self_ID.Deferral_Level > 0); pragma Assert (Self_ID = Self); @@ -1607,7 +1607,7 @@ package body System.Tasking.Stages is -- It is also called from Unchecked_Deallocation, for objects that -- are or contain tasks. - procedure Vulnerable_Free_Task (T : Task_ID) is + procedure Vulnerable_Free_Task (T : Task_Id) is begin pragma Debug (Debug.Trace (Self, "Vulnerable_Free_Task", 'C', T)); diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index 25018389891..ba9ab044c77 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -177,7 +177,7 @@ package System.Tasking.Stages is Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; - Created_Task : out Task_ID); + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- @@ -250,12 +250,12 @@ package System.Tasking.Stages is -- It currently also executes the global finalization list, and then resets -- the "soft links". - procedure Free_Task (T : Task_ID); + procedure Free_Task (T : Task_Id); -- Recover all runtime system storage associated with the task T, but only -- if T has terminated. Do nothing in the other case. It is called from -- Unchecked_Deallocation, for objects that are or contain tasks. - function Terminated (T : Task_ID) return Boolean; + function Terminated (T : Task_Id) return Boolean; -- This is called by the compiler to implement the 'Terminated attribute. -- Though is not required to be so by the ARM, we choose to synchronize -- with the task's ATCB, so that this is more useful for polling the state @@ -268,7 +268,7 @@ package System.Tasking.Stages is -- code expansion: -- terminated (t1._task_id) - procedure Terminate_Task (Self_ID : Task_ID); + procedure Terminate_Task (Self_ID : Task_Id); -- Terminate the calling task. -- This should only be called by the Task_Wrapper procedure, and to -- deallocate storage associate with foreign tasks. diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb index 37e6b44901d..47ba6665570 100644 --- a/gcc/ada/s-tasuti.adb +++ b/gcc/ada/s-tasuti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -92,7 +92,7 @@ package body System.Tasking.Utilities is -- (2) may be called for tasks that have not yet been activated -- (3) always aborts whole task - procedure Abort_One_Task (Self_ID : Task_ID; T : Task_ID) is + procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id) is begin if Parameters.Runtime_Traces then Send_Trace_Info (T_Abort, Self_ID, T); @@ -126,9 +126,9 @@ package body System.Tasking.Utilities is -- Abort_Signal special exception. procedure Abort_Tasks (Tasks : Task_List) is - Self_Id : constant Task_ID := STPO.Self; - C : Task_ID; - P : Task_ID; + Self_Id : constant Task_Id := STPO.Self; + C : Task_Id; + P : Task_Id; begin Initialization.Defer_Abort_Nestable (Self_Id); @@ -178,12 +178,12 @@ package body System.Tasking.Utilities is -- This should only be called by T, unless T is a terminated previously -- unactivated task. - procedure Cancel_Queued_Entry_Calls (T : Task_ID) is + procedure Cancel_Queued_Entry_Calls (T : Task_Id) is Next_Entry_Call : Entry_Call_Link; Entry_Call : Entry_Call_Link; - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; - Caller : Task_ID; + Caller : Task_Id; pragma Unreferenced (Caller); -- Should this be removed ??? @@ -230,7 +230,7 @@ package body System.Tasking.Utilities is -- In any case, reset Self_Id.Aborting, to allow re-raising of -- Abort_Signal. - procedure Exit_One_ATC_Level (Self_ID : Task_ID) is + procedure Exit_One_ATC_Level (Self_ID : Task_Id) is begin Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1; @@ -263,9 +263,9 @@ package body System.Tasking.Utilities is ---------------------- procedure Make_Independent is - Self_Id : constant Task_ID := STPO.Self; - Environment_Task : constant Task_ID := STPO.Environment_Task; - Parent : constant Task_ID := Self_Id.Common.Parent; + Self_Id : constant Task_Id := STPO.Self; + Environment_Task : constant Task_Id := STPO.Environment_Task; + Parent : constant Task_Id := Self_Id.Common.Parent; Parent_Needs_Updating : Boolean := False; Master_of_Task : Integer; @@ -347,9 +347,9 @@ package body System.Tasking.Utilities is -- Make_Passive -- ------------------ - procedure Make_Passive (Self_ID : Task_ID; Task_Completed : Boolean) is - C : Task_ID := Self_ID; - P : Task_ID := C.Common.Parent; + procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean) is + C : Task_Id := Self_ID; + P : Task_Id := C.Common.Parent; Master_Completion_Phase : Integer; diff --git a/gcc/ada/s-tasuti.ads b/gcc/ada/s-tasuti.ads index dfdd274fd3b..8a4708a6c95 100644 --- a/gcc/ada/s-tasuti.ads +++ b/gcc/ada/s-tasuti.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -39,7 +39,7 @@ with Unchecked_Conversion; package System.Tasking.Utilities is function ATCB_To_Address is new - Unchecked_Conversion (Task_ID, System.Address); + Unchecked_Conversion (Task_Id, System.Address); --------------------------------- -- Task_Stage Related routines -- @@ -76,17 +76,17 @@ package System.Tasking.Utilities is -- Task Abortion related routines -- ------------------------------------ - procedure Cancel_Queued_Entry_Calls (T : Task_ID); + procedure Cancel_Queued_Entry_Calls (T : Task_Id); -- Cancel any entry calls queued on target task. -- Call this while holding T's lock (or RTS_Lock in Single_Lock mode). - procedure Exit_One_ATC_Level (Self_ID : Task_ID); + procedure Exit_One_ATC_Level (Self_ID : Task_Id); pragma Inline (Exit_One_ATC_Level); -- Call only with abort deferred and holding lock of Self_ID. -- This is a bit of common code for all entry calls. -- The effect is to exit one level of ATC nesting. - procedure Abort_One_Task (Self_ID : Task_ID; T : Task_ID); + procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id); -- Similar to Locked_Abort_To_Level (Self_ID, T, 0), but: -- (1) caller should be holding no locks -- (2) may be called for tasks that have not yet been activated @@ -96,7 +96,7 @@ package System.Tasking.Utilities is -- Abort_Tasks is called to initiate abortion, however, the actual -- abortion is done by abortee by means of Abort_Handler - procedure Make_Passive (Self_ID : Task_ID; Task_Completed : Boolean); + procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean); -- Update counts to indicate current task is either terminated -- or accepting on a terminate alternative. -- Call holding no locks except Global_Task_Lock when calling from diff --git a/gcc/ada/s-tataat.adb b/gcc/ada/s-tataat.adb index b3660f3b04c..cabeda73ca7 100644 --- a/gcc/ada/s-tataat.adb +++ b/gcc/ada/s-tataat.adb @@ -100,7 +100,7 @@ package body System.Tasking.Task_Attributes is -- Deallocation does finalization, if necessary. declare - C : System.Tasking.Task_ID := All_Tasks_List; + C : System.Tasking.Task_Id := All_Tasks_List; P : Access_Node; begin @@ -158,7 +158,7 @@ package body System.Tasking.Task_Attributes is -- This is to be called just before the ATCB is deallocated. -- It relies on the caller holding T.L write-lock on entry. - procedure Finalize_Attributes (T : Task_ID) is + procedure Finalize_Attributes (T : Task_Id) is P : Access_Node; Q : Access_Node := To_Access_Node (T.Indirect_Attributes); @@ -185,7 +185,7 @@ package body System.Tasking.Task_Attributes is -- This is to be called by System.Tasking.Stages.Create_Task. - procedure Initialize_Attributes (T : Task_ID) is + procedure Initialize_Attributes (T : Task_Id) is P : Access_Instance; begin Defer_Abortion; diff --git a/gcc/ada/s-tataat.ads b/gcc/ada/s-tataat.ads index 821197593cc..d8716cd02e4 100644 --- a/gcc/ada/s-tataat.ads +++ b/gcc/ada/s-tataat.ads @@ -116,13 +116,13 @@ package System.Tasking.Task_Attributes is -- A linked list of all indirectly access attributes, -- which includes all those that require finalization. - procedure Initialize_Attributes (T : Task_ID); + procedure Initialize_Attributes (T : Task_Id); -- Initialize all attributes created via Ada.Task_Attributes for T. -- This must be called by the creator of the task, inside Create_Task, -- via soft-link Initialize_Attributes_Link. On entry, abortion must -- be deferred and the caller must hold no locks - procedure Finalize_Attributes (T : Task_ID); + procedure Finalize_Attributes (T : Task_Id); -- Finalize all attributes created via Ada.Task_Attributes for T. -- This is to be called by the task after it is marked as terminated -- (and before it actually dies), inside Vulnerable_Free_Task, via the diff --git a/gcc/ada/s-tpinop.adb b/gcc/ada/s-tpinop.adb index 05c44405c1f..fa39b65311c 100644 --- a/gcc/ada/s-tpinop.adb +++ b/gcc/ada/s-tpinop.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,7 +38,7 @@ package body System.Task_Primitives.Interrupt_Operations is -- this array, but due to elaboration problems, it can't with this -- package directly, so we export this variable for now. - Interrupt_ID_Map : array (IM.Interrupt_ID) of ST.Task_ID; + Interrupt_ID_Map : array (IM.Interrupt_ID) of ST.Task_Id; pragma Export (Ada, Interrupt_ID_Map, "system__task_primitives__interrupt_operations__interrupt_id_map"); @@ -46,8 +46,8 @@ package body System.Task_Primitives.Interrupt_Operations is -- Get_Interrupt_ID -- ---------------------- - function Get_Interrupt_ID (T : ST.Task_ID) return IM.Interrupt_ID is - use type ST.Task_ID; + function Get_Interrupt_ID (T : ST.Task_Id) return IM.Interrupt_ID is + use type ST.Task_Id; begin for Interrupt in IM.Interrupt_ID loop @@ -60,19 +60,19 @@ package body System.Task_Primitives.Interrupt_Operations is end Get_Interrupt_ID; ----------------- - -- Get_Task_ID -- + -- Get_Task_Id -- ----------------- - function Get_Task_ID (Interrupt : IM.Interrupt_ID) return ST.Task_ID is + function Get_Task_Id (Interrupt : IM.Interrupt_ID) return ST.Task_Id is begin return Interrupt_ID_Map (Interrupt); - end Get_Task_ID; + end Get_Task_Id; ---------------------- -- Set_Interrupt_ID -- ---------------------- - procedure Set_Interrupt_ID (Interrupt : IM.Interrupt_ID; T : ST.Task_ID) is + procedure Set_Interrupt_ID (Interrupt : IM.Interrupt_ID; T : ST.Task_Id) is begin Interrupt_ID_Map (Interrupt) := T; end Set_Interrupt_ID; diff --git a/gcc/ada/s-tpinop.ads b/gcc/ada/s-tpinop.ads index 4c96ca28e0a..94c165aaa95 100644 --- a/gcc/ada/s-tpinop.ads +++ b/gcc/ada/s-tpinop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,13 +38,13 @@ package System.Task_Primitives.Interrupt_Operations is package IM renames System.Interrupt_Management; package ST renames System.Tasking; - procedure Set_Interrupt_ID (Interrupt : IM.Interrupt_ID; T : ST.Task_ID); + procedure Set_Interrupt_ID (Interrupt : IM.Interrupt_ID; T : ST.Task_Id); -- Associate an Interrupt_ID with a task. - function Get_Interrupt_ID (T : ST.Task_ID) return IM.Interrupt_ID; + function Get_Interrupt_ID (T : ST.Task_Id) return IM.Interrupt_ID; -- Return the Interrupt_ID associated with a task. - function Get_Task_ID (Interrupt : IM.Interrupt_ID) return ST.Task_ID; - -- Return the Task_ID associated with an Interrupt. + function Get_Task_Id (Interrupt : IM.Interrupt_ID) return ST.Task_Id; + -- Return the Task_Id associated with an Interrupt. end System.Task_Primitives.Interrupt_Operations; diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index 45ef97fb244..a195828c9b2 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2001, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -81,9 +81,9 @@ package body System.Tasking.Protected_Objects.Entries is procedure Finalize (Object : in out Protection_Entries) is Entry_Call : Entry_Call_Link; - Caller : Task_ID; + Caller : Task_Id; Ceiling_Violation : Boolean; - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; Old_Base_Priority : System.Any_Priority; begin @@ -179,7 +179,7 @@ package body System.Tasking.Protected_Objects.Entries is Find_Body_Index : Find_Body_Index_Access) is Init_Priority : Integer := Ceiling_Priority; - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin if Init_Priority = Unspecified_Priority then diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index a77fb63a3ba..3535a79ef74 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -120,7 +120,7 @@ package body System.Tasking.Protected_Objects.Operations is -- It returns with the PO's lock still held. procedure Requeue_Call - (Self_Id : Task_ID; + (Self_Id : Task_Id; Object : Protection_Entries_Access; Entry_Call : Entry_Call_Link; With_Abort : Boolean); @@ -292,7 +292,7 @@ package body System.Tasking.Protected_Objects.Operations is -------------------- procedure PO_Do_Or_Queue - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Protection_Entries_Access; Entry_Call : Entry_Call_Link; With_Abort : Boolean) @@ -382,12 +382,12 @@ package body System.Tasking.Protected_Objects.Operations is ------------------------ procedure PO_Service_Entries - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Entries.Protection_Entries_Access; Unlock_Object : Boolean := True) is E : Protected_Entry_Index; - Caller : Task_ID; + Caller : Task_Id; Entry_Call : Entry_Call_Link; begin @@ -519,7 +519,7 @@ package body System.Tasking.Protected_Objects.Operations is Mode : Call_Modes; Block : out Communication_Block) is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; Initially_Abortable : Boolean; Ceiling_Violation : Boolean; @@ -653,7 +653,7 @@ package body System.Tasking.Protected_Objects.Operations is ------------------ procedure Requeue_Call - (Self_Id : Task_ID; + (Self_Id : Task_Id; Object : Protection_Entries_Access; Entry_Call : Entry_Call_Link; With_Abort : Boolean) @@ -739,7 +739,7 @@ package body System.Tasking.Protected_Objects.Operations is ---------------------------- function Protected_Entry_Caller - (Object : Protection_Entries'Class) return Task_ID is + (Object : Protection_Entries'Class) return Task_Id is begin return Object.Call_In_Progress.Self; end Protected_Entry_Caller; @@ -837,7 +837,7 @@ package body System.Tasking.Protected_Objects.Operations is E : Protected_Entry_Index; With_Abort : Boolean) is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; Entry_Call : constant Entry_Call_Link := Self_ID.Common.Call; begin @@ -859,7 +859,7 @@ package body System.Tasking.Protected_Objects.Operations is --------------------- procedure Service_Entries (Object : Protection_Entries_Access) is - Self_ID : constant Task_ID := STPO.Self; + Self_ID : constant Task_Id := STPO.Self; begin PO_Service_Entries (Self_ID, Object); end Service_Entries; @@ -878,7 +878,7 @@ package body System.Tasking.Protected_Objects.Operations is Mode : Delay_Modes; Entry_Call_Successful : out Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; Ceiling_Violation : Boolean; Yielded : Boolean; diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads index a28972b62a1..c53e59e0fc5 100644 --- a/gcc/ada/s-tpobop.ads +++ b/gcc/ada/s-tpobop.ads @@ -95,7 +95,7 @@ package System.Tasking.Protected_Objects.Operations is pragma Inline (Service_Entries); procedure PO_Service_Entries - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Entries.Protection_Entries_Access; Unlock_Object : Boolean := True); -- Service all entry queues of the specified object, executing the @@ -176,7 +176,7 @@ package System.Tasking.Protected_Objects.Operations is -- Return the number of entry calls to E on Object. function Protected_Entry_Caller - (Object : Entries.Protection_Entries'Class) return Task_ID; + (Object : Entries.Protection_Entries'Class) return Task_Id; -- Return value of E'Caller, where E is the protected entry currently -- being handled. This will only work if called from within an entry -- body, as required by the LRM (C.7.1(14)). @@ -184,7 +184,7 @@ package System.Tasking.Protected_Objects.Operations is -- For internal use only: procedure PO_Do_Or_Queue - (Self_ID : Task_ID; + (Self_ID : Task_Id; Object : Entries.Protection_Entries_Access; Entry_Call : Entry_Call_Link; With_Abort : Boolean); @@ -194,7 +194,7 @@ package System.Tasking.Protected_Objects.Operations is private type Communication_Block is record - Self : Task_ID; + Self : Task_Id; Enqueued : Boolean := True; Cancelled : Boolean := False; end record; diff --git a/gcc/ada/s-tpopde-vms.adb b/gcc/ada/s-tpopde-vms.adb index 89db8240ad8..5fa9a92e21d 100644 --- a/gcc/ada/s-tpopde-vms.adb +++ b/gcc/ada/s-tpopde-vms.adb @@ -70,10 +70,10 @@ package body System.Task_Primitives.Operations.DEC is ----------------------- function To_Unsigned_Longword is new - Unchecked_Conversion (Task_ID, Unsigned_Longword); + Unchecked_Conversion (Task_Id, Unsigned_Longword); function To_Task_Id is new - Unchecked_Conversion (Unsigned_Longword, Task_ID); + Unchecked_Conversion (Unsigned_Longword, Task_Id); function To_FAB_RAB is new Unchecked_Conversion (Address, FAB_RAB_Access_Type); @@ -84,7 +84,7 @@ package body System.Task_Primitives.Operations.DEC is procedure Interrupt_AST_Handler (ID : Address) is Result : Interfaces.C.int; - AST_Self_ID : constant Task_ID := To_Task_ID (ID); + AST_Self_ID : constant Task_Id := To_Task_Id (ID); begin Result := pthread_cond_signal_int_np (AST_Self_ID.Common.LL.CV'Access); pragma Assert (Result = 0); @@ -95,7 +95,7 @@ package body System.Task_Primitives.Operations.DEC is --------------------- procedure RMS_AST_Handler (ID : Address) is - AST_Self_ID : constant Task_ID := To_Task_Id (To_FAB_RAB (ID).CTX); + AST_Self_ID : constant Task_Id := To_Task_Id (To_FAB_RAB (ID).CTX); Result : Interfaces.C.int; begin @@ -109,7 +109,7 @@ package body System.Task_Primitives.Operations.DEC is ---------- function Self return Unsigned_Longword is - Self_ID : constant Task_ID := Self; + Self_ID : constant Task_Id := Self; begin Self_ID.Common.LL.AST_Pending := True; return To_Unsigned_Longword (Self); @@ -121,7 +121,7 @@ package body System.Task_Primitives.Operations.DEC is procedure Starlet_AST_Handler (ID : Address) is Result : Interfaces.C.int; - AST_Self_ID : constant Task_ID := To_Task_ID (ID); + AST_Self_ID : constant Task_Id := To_Task_Id (ID); begin AST_Self_ID.Common.LL.AST_Pending := False; Result := pthread_cond_signal_int_np (AST_Self_ID.Common.LL.CV'Access); @@ -133,7 +133,7 @@ package body System.Task_Primitives.Operations.DEC is ---------------- procedure Task_Synch is - Synch_Self_ID : constant Task_ID := Self; + Synch_Self_ID : constant Task_Id := Self; begin if Single_Lock then diff --git a/gcc/ada/s-tpopsp-lynxos.adb b/gcc/ada/s-tpopsp-lynxos.adb index 2673d0e30b6..91bf83ea973 100644 --- a/gcc/ada/s-tpopsp-lynxos.adb +++ b/gcc/ada/s-tpopsp-lynxos.adb @@ -40,7 +40,7 @@ package body Specific is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is pragma Warnings (Off, Environment_Task); Result : Interfaces.C.int; @@ -66,7 +66,7 @@ package body Specific is -- Set -- --------- - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Result : Interfaces.C.int; begin @@ -91,7 +91,7 @@ package body Specific is -- hierarchy, much like the existing implicitly created signal-server -- tasks. - function Self return Task_ID is + function Self return Task_Id is Value : aliased System.Address; Result : Interfaces.C.int; @@ -104,7 +104,7 @@ package body Specific is -- If the key value is Null, then it is a non-Ada task. if Value /= System.Null_Address then - return To_Task_ID (Value); + return To_Task_Id (Value); else return Register_Foreign_Thread; end if; diff --git a/gcc/ada/s-tpopsp-posix-foreign.adb b/gcc/ada/s-tpopsp-posix-foreign.adb index c1c0815c790..7cac3b504d0 100644 --- a/gcc/ada/s-tpopsp-posix-foreign.adb +++ b/gcc/ada/s-tpopsp-posix-foreign.adb @@ -44,7 +44,7 @@ package body Specific is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is pragma Warnings (Off, Environment_Task); Result : Interfaces.C.int; @@ -66,7 +66,7 @@ package body Specific is -- Set -- --------- - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Result : Interfaces.C.int; begin Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id)); @@ -90,7 +90,7 @@ package body Specific is -- hierarchy, much like the existing implicitly created signal-server -- tasks. - function Self return Task_ID is + function Self return Task_Id is Result : System.Address; begin @@ -99,7 +99,7 @@ package body Specific is -- If the key value is Null, then it is a non-Ada task. if Result /= System.Null_Address then - return To_Task_ID (Result); + return To_Task_Id (Result); else return Register_Foreign_Thread; end if; diff --git a/gcc/ada/s-tpopsp-posix.adb b/gcc/ada/s-tpopsp-posix.adb index f7a67a074ca..6c3e74676d5 100644 --- a/gcc/ada/s-tpopsp-posix.adb +++ b/gcc/ada/s-tpopsp-posix.adb @@ -40,7 +40,7 @@ package body Specific is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is pragma Warnings (Off, Environment_Task); Result : Interfaces.C.int; begin @@ -61,7 +61,7 @@ package body Specific is -- Set -- --------- - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Result : Interfaces.C.int; begin Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id)); @@ -72,9 +72,9 @@ package body Specific is -- Self -- ---------- - function Self return Task_ID is + function Self return Task_Id is begin - return To_Task_ID (pthread_getspecific (ATCB_Key)); + return To_Task_Id (pthread_getspecific (ATCB_Key)); end Self; end Specific; diff --git a/gcc/ada/s-tpopsp-solaris.adb b/gcc/ada/s-tpopsp-solaris.adb index eb32dd2cb81..eb0fabebd50 100644 --- a/gcc/ada/s-tpopsp-solaris.adb +++ b/gcc/ada/s-tpopsp-solaris.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. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -40,7 +40,7 @@ package body Specific is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is Result : Interfaces.C.int; begin Result := thr_setspecific (ATCB_Key, To_Address (Environment_Task)); @@ -64,7 +64,7 @@ package body Specific is -- Set -- --------- - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Result : Interfaces.C.int; begin Result := thr_setspecific (ATCB_Key, To_Address (Self_Id)); @@ -90,7 +90,7 @@ package body Specific is -- master hierarchy, much like the existing implicitly created -- signal-server tasks. - function Self return Task_ID is + function Self return Task_Id is Result : Interfaces.C.int; Self_Id : aliased System.Address; begin @@ -100,7 +100,7 @@ package body Specific is if Self_Id = System.Null_Address then return Register_Foreign_Thread; else - return To_Task_ID (Self_Id); + return To_Task_Id (Self_Id); end if; end Self; diff --git a/gcc/ada/s-tpopsp-vxworks.adb b/gcc/ada/s-tpopsp-vxworks.adb index 02983287d2c..965d1c9bfcb 100644 --- a/gcc/ada/s-tpopsp-vxworks.adb +++ b/gcc/ada/s-tpopsp-vxworks.adb @@ -50,7 +50,7 @@ package body Specific is -- Set -- --------- - procedure Set (Self_Id : Task_ID) is + procedure Set (Self_Id : Task_Id) is Result : STATUS; begin @@ -66,9 +66,9 @@ package body Specific is -- Self -- ---------- - function Self return Task_ID is + function Self return Task_Id is begin - return To_Task_ID (ATCB_Key); + return To_Task_Id (ATCB_Key); end Self; end Specific; diff --git a/gcc/ada/s-tporft.adb b/gcc/ada/s-tporft.adb index 43c5da9da39..feb922a6ce6 100644 --- a/gcc/ada/s-tporft.adb +++ b/gcc/ada/s-tporft.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2004, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,9 +38,9 @@ with System.Soft_Links; -- used to initialize TSD for a C thread, in function Self separate (System.Task_Primitives.Operations) -function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID is +function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is Local_ATCB : aliased Ada_Task_Control_Block (0); - Self_Id : Task_ID; + Self_Id : Task_Id; Succeeded : Boolean; use type Interfaces.C.unsigned; @@ -51,7 +51,7 @@ begin -- immediately, we fake one, so that it is then possible to e.g allocate -- memory (which might require accessing self). - -- Record this as the Task_ID for the thread + -- Record this as the Task_Id for the thread Local_ATCB.Common.LL.Thread := Thread; Local_ATCB.Common.Current_Priority := System.Priority'First; diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index b1a3ef29a4b..25a8251b9dc 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -83,7 +83,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is ----------------------- procedure Send_Program_Error - (Self_Id : Task_ID; + (Self_Id : Task_Id; Entry_Call : Entry_Call_Link); pragma Inline (Send_Program_Error); -- Raise Program_Error in the caller of the specified entry call @@ -93,7 +93,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -------------------------- procedure Wakeup_Entry_Caller - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; New_State : Entry_Call_State); pragma Inline (Wakeup_Entry_Caller); @@ -121,7 +121,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- specified in Wakeup_Time as well. procedure Check_Exception - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); pragma Inline (Check_Exception); -- Raise any pending exception from the Entry_Call. @@ -130,7 +130,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- The caller should not be holding any locks, or there will be deadlock. procedure PO_Do_Or_Queue - (Self_Id : Task_ID; + (Self_Id : Task_Id; Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link); -- This procedure executes or queues an entry call, depending @@ -142,7 +142,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is --------------------- procedure Check_Exception - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link) is pragma Warnings (Off, Self_ID); @@ -166,10 +166,10 @@ package body System.Tasking.Protected_Objects.Single_Entry is ------------------------ procedure Send_Program_Error - (Self_Id : Task_ID; + (Self_Id : Task_Id; Entry_Call : Entry_Call_Link) is - Caller : constant Task_ID := Entry_Call.Self; + Caller : constant Task_Id := Entry_Call.Self; begin Entry_Call.Exception_To_Raise := Program_Error'Identity; @@ -191,7 +191,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is ------------------------- procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is - Self_Id : constant Task_ID := Entry_Call.Self; + Self_Id : constant Task_Id := Entry_Call.Self; begin Self_Id.Common.State := Entry_Caller_Sleep; STPO.Sleep (Self_Id, Entry_Caller_Sleep); @@ -207,7 +207,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is Wakeup_Time : Duration; Mode : Delay_Modes) is - Self_Id : constant Task_ID := Entry_Call.Self; + Self_Id : constant Task_Id := Entry_Call.Self; Timedout : Boolean; Yielded : Boolean; @@ -267,13 +267,13 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- to complete. procedure Wakeup_Entry_Caller - (Self_ID : Task_ID; + (Self_ID : Task_Id; Entry_Call : Entry_Call_Link; New_State : Entry_Call_State) is pragma Warnings (Off, Self_ID); - Caller : constant Task_ID := Entry_Call.Self; + Caller : constant Task_Id := Entry_Call.Self; begin pragma Assert (New_State = Done or else New_State = Cancelled); @@ -377,7 +377,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -------------------- procedure PO_Do_Or_Queue - (Self_Id : Task_ID; + (Self_Id : Task_Id; Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link) is @@ -460,7 +460,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is Uninterpreted_Data : System.Address; Mode : Call_Modes) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); Ceiling_Violation : Boolean; @@ -506,7 +506,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is ----------------------------------- function Protected_Single_Entry_Caller - (Object : Protection_Entry) return Task_ID is + (Object : Protection_Entry) return Task_Id is begin return Object.Call_In_Progress.Self; end Protected_Single_Entry_Caller; @@ -516,9 +516,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is ------------------- procedure Service_Entry (Object : Protection_Entry_Access) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : constant Entry_Call_Link := Object.Entry_Queue; - Caller : Task_ID; + Caller : Task_Id; begin if Entry_Call /= null then @@ -574,7 +574,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is Mode : Delay_Modes; Entry_Call_Successful : out Boolean) is - Self_Id : constant Task_ID := STPO.Self; + Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); Ceiling_Violation : Boolean; diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index 6ad90c7fe64..148098f4cae 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -270,7 +270,7 @@ package System.Tasking.Protected_Objects.Single_Entry is -- Return the number of entry calls on Object (0 or 1). function Protected_Single_Entry_Caller (Object : Protection_Entry) - return Task_ID; + return Task_Id; -- Return value of E'Caller, where E is the protected entry currently -- being handled. This will only work if called from within an -- entry body, as required by the LRM (C.7.1(14)). diff --git a/gcc/ada/s-tratas-default.adb b/gcc/ada/s-tratas-default.adb index 0e18aed2d96..89938c45caa 100644 --- a/gcc/ada/s-tratas-default.adb +++ b/gcc/ada/s-tratas-default.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -45,7 +45,7 @@ package body System.Traces.Tasking is package SSL renames System.Soft_Links; - function Extract_Accepts (Task_Name : Task_ID) return String_Trace; + function Extract_Accepts (Task_Name : Task_Id) return String_Trace; -- This function is used to extract data joined with -- W_Select, WT_Select, W_Accept events @@ -53,7 +53,7 @@ package body System.Traces.Tasking is -- Send_Trace_Info -- --------------------- - procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : Task_ID) is + procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : Task_Id) is Task_S : constant String := SSL.Task_Name.all; Task2_S : constant String := Task_Name2.Common.Task_Image @@ -101,7 +101,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name2 : Task_ID; + Task_Name2 : Task_Id; Entry_Number : Entry_Index) is Task_S : constant String := SSL.Task_Name.all; @@ -146,8 +146,8 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : Task_ID; - Task_Name2 : Task_ID; + Task_Name : Task_Id; + Task_Name2 : Task_Id; Entry_Number : Entry_Index) is Task_S : constant String := @@ -201,8 +201,8 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : Task_ID; - Task_Name2 : Task_ID) + Task_Name : Task_Id; + Task_Name2 : Task_Id) is Task_S : constant String := Task_Name.Common.Task_Image @@ -226,7 +226,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Acceptor : Task_ID; + Acceptor : Task_Id; Entry_Number : Entry_Index; Timeout : Duration) is @@ -285,7 +285,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : Task_ID; + Task_Name : Task_Id; Number : Integer) is Task_S : String := SSL.Task_Name.all; @@ -311,7 +311,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : Task_ID; + Task_Name : Task_Id; Number : Integer; Timeout : Duration) is @@ -347,7 +347,7 @@ package body System.Traces.Tasking is -- This function returns a string in which all opened -- Accepts or Selects are given, separated by semi-colons. - function Extract_Accepts (Task_Name : Task_ID) return String_Trace is + function Extract_Accepts (Task_Name : Task_Id) return String_Trace is Info_Annex : String_Trace := (ASCII.NUL, others => ' '); begin diff --git a/gcc/ada/s-tratas.adb b/gcc/ada/s-tratas.adb index 241fdaa1bbc..448fbfa49d9 100644 --- a/gcc/ada/s-tratas.adb +++ b/gcc/ada/s-tratas.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -39,14 +39,14 @@ package body System.Traces.Tasking is -- Send_Trace_Info -- --------------------- - procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : ST.Task_ID) is + procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : ST.Task_Id) is begin null; end Send_Trace_Info; procedure Send_Trace_Info (Id : Trace_T; - Task_Name2 : ST.Task_ID; + Task_Name2 : ST.Task_Id; Entry_Number : ST.Entry_Index) is begin @@ -55,8 +55,8 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; - Task_Name2 : ST.Task_ID; + Task_Name : ST.Task_Id; + Task_Name2 : ST.Task_Id; Entry_Number : ST.Entry_Index) is begin @@ -65,8 +65,8 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; - Task_Name2 : ST.Task_ID) + Task_Name : ST.Task_Id; + Task_Name2 : ST.Task_Id) is begin null; @@ -82,7 +82,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Acceptor : ST.Task_ID; + Acceptor : ST.Task_Id; Entry_Number : ST.Entry_Index; Timeout : Duration) is @@ -101,7 +101,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; + Task_Name : ST.Task_Id; Number : Integer) is begin @@ -110,7 +110,7 @@ package body System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; + Task_Name : ST.Task_Id; Number : Integer; Timeout : Duration) is diff --git a/gcc/ada/s-tratas.ads b/gcc/ada/s-tratas.ads index c54399324eb..c9a1e4a4272 100644 --- a/gcc/ada/s-tratas.ads +++ b/gcc/ada/s-tratas.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -50,23 +50,23 @@ package System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name2 : ST.Task_ID); + Task_Name2 : ST.Task_Id); procedure Send_Trace_Info (Id : Trace_T; - Task_Name2 : ST.Task_ID; + Task_Name2 : ST.Task_Id; Entry_Number : ST.Entry_Index); procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; - Task_Name2 : ST.Task_ID; + Task_Name : ST.Task_Id; + Task_Name2 : ST.Task_Id; Entry_Number : ST.Entry_Index); procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; - Task_Name2 : ST.Task_ID); + Task_Name : ST.Task_Id; + Task_Name2 : ST.Task_Id); procedure Send_Trace_Info (Id : Trace_T; @@ -74,7 +74,7 @@ package System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Acceptor : ST.Task_ID; + Acceptor : ST.Task_Id; Entry_Number : ST.Entry_Index; Timeout : Duration); @@ -85,12 +85,12 @@ package System.Traces.Tasking is procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; + Task_Name : ST.Task_Id; Number : Integer); procedure Send_Trace_Info (Id : Trace_T; - Task_Name : ST.Task_ID; + Task_Name : ST.Task_Id; Number : Integer; Timeout : Duration); end System.Traces.Tasking; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index afe954e71ac..031ffa41e94 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2090,7 +2090,7 @@ package body Sem_Attr is end if; end loop; - Set_Etype (N, RTE (RO_AT_Task_ID)); + Set_Etype (N, RTE (RO_AT_Task_Id)); end Caller; ------------- @@ -2627,7 +2627,7 @@ package body Sem_Attr is and then Is_Task_Type (Designated_Type (Etype (P)))) then Resolve (P); - Set_Etype (N, RTE (RO_AT_Task_ID)); + Set_Etype (N, RTE (RO_AT_Task_Id)); else Error_Attr ("prefix of % attribute must be a task or an " diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 4283ae0beb2..ac065d0edf5 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3352,7 +3352,9 @@ package body Sem_Ch10 is -- view because the full view of X supersedes its limited view. if Analyzed (Cunit (Unum)) - and then Is_Immediately_Visible (P) + and then (Is_Immediately_Visible (P) + or else (Is_Child_Package + and then Is_Visible_Child_Unit (P))) then return; end if; 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 diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index d764320be36..ca49ae76de4 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -342,6 +342,7 @@ package body Snames is "link_name#" & "lowercase#" & "max_entry_queue_depth#" & + "max_entry_queue_length#" & "max_size#" & "mechanism#" & "mixedcase#" & @@ -352,9 +353,12 @@ package body Snames is "on#" & "parameter_types#" & "reference#" & + "no_dynamic_attachment#" & "no_dynamic_interrupts#" & "no_requeue#" & + "no_requeue_statements#" & "no_task_attributes#" & + "no_task_attributes_package#" & "restricted#" & "result_mechanism#" & "result_type#" & @@ -363,6 +367,7 @@ package body Snames is "secondary_stack_size#" & "section#" & "semaphore#" & + "simple_barriers#" & "spec_file_name#" & "static#" & "stack_size#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 402a791ef63..d4a5ad4dc12 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -540,46 +540,51 @@ package Snames is Name_Link_Name : constant Name_Id := N + 282; Name_Lowercase : constant Name_Id := N + 283; Name_Max_Entry_Queue_Depth : constant Name_Id := N + 284; - Name_Max_Size : constant Name_Id := N + 285; - Name_Mechanism : constant Name_Id := N + 286; - Name_Mixedcase : constant Name_Id := N + 287; - Name_Modified_GPL : constant Name_Id := N + 288; - Name_Name : constant Name_Id := N + 289; - Name_NCA : constant Name_Id := N + 290; - Name_No : constant Name_Id := N + 291; - Name_On : constant Name_Id := N + 292; - Name_Parameter_Types : constant Name_Id := N + 293; - Name_Reference : constant Name_Id := N + 294; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 295; - Name_No_Requeue : constant Name_Id := N + 296; - Name_No_Task_Attributes : constant Name_Id := N + 297; - Name_Restricted : constant Name_Id := N + 298; - Name_Result_Mechanism : constant Name_Id := N + 299; - Name_Result_Type : constant Name_Id := N + 300; - Name_Runtime : constant Name_Id := N + 301; - Name_SB : constant Name_Id := N + 302; - Name_Secondary_Stack_Size : constant Name_Id := N + 303; - Name_Section : constant Name_Id := N + 304; - Name_Semaphore : constant Name_Id := N + 305; - Name_Spec_File_Name : constant Name_Id := N + 306; - Name_Static : constant Name_Id := N + 307; - Name_Stack_Size : constant Name_Id := N + 308; - Name_Subunit_File_Name : constant Name_Id := N + 309; - Name_Task_Stack_Size_Default : constant Name_Id := N + 310; - Name_Task_Type : constant Name_Id := N + 311; - Name_Time_Slicing_Enabled : constant Name_Id := N + 312; - Name_Top_Guard : constant Name_Id := N + 313; - Name_UBA : constant Name_Id := N + 314; - Name_UBS : constant Name_Id := N + 315; - Name_UBSB : constant Name_Id := N + 316; - Name_Unit_Name : constant Name_Id := N + 317; - Name_Unknown : constant Name_Id := N + 318; - Name_Unrestricted : constant Name_Id := N + 319; - Name_Uppercase : constant Name_Id := N + 320; - Name_User : constant Name_Id := N + 321; - Name_VAX_Float : constant Name_Id := N + 322; - Name_VMS : constant Name_Id := N + 323; - Name_Working_Storage : constant Name_Id := N + 324; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 285; + Name_Max_Size : constant Name_Id := N + 286; + Name_Mechanism : constant Name_Id := N + 287; + Name_Mixedcase : constant Name_Id := N + 288; + Name_Modified_GPL : constant Name_Id := N + 289; + Name_Name : constant Name_Id := N + 290; + Name_NCA : constant Name_Id := N + 291; + Name_No : constant Name_Id := N + 292; + Name_On : constant Name_Id := N + 293; + Name_Parameter_Types : constant Name_Id := N + 294; + Name_Reference : constant Name_Id := N + 295; + Name_No_Dynamic_Attachment : constant Name_Id := N + 296; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 297; + Name_No_Requeue : constant Name_Id := N + 298; + Name_No_Requeue_Statements : constant Name_Id := N + 299; + Name_No_Task_Attributes : constant Name_Id := N + 300; + Name_No_Task_Attributes_Package : constant Name_Id := N + 301; + Name_Restricted : constant Name_Id := N + 302; + Name_Result_Mechanism : constant Name_Id := N + 303; + Name_Result_Type : constant Name_Id := N + 304; + Name_Runtime : constant Name_Id := N + 305; + Name_SB : constant Name_Id := N + 306; + Name_Secondary_Stack_Size : constant Name_Id := N + 307; + Name_Section : constant Name_Id := N + 308; + Name_Semaphore : constant Name_Id := N + 309; + Name_Simple_Barriers : constant Name_Id := N + 310; + Name_Spec_File_Name : constant Name_Id := N + 311; + Name_Static : constant Name_Id := N + 312; + Name_Stack_Size : constant Name_Id := N + 313; + Name_Subunit_File_Name : constant Name_Id := N + 314; + Name_Task_Stack_Size_Default : constant Name_Id := N + 315; + Name_Task_Type : constant Name_Id := N + 316; + Name_Time_Slicing_Enabled : constant Name_Id := N + 317; + Name_Top_Guard : constant Name_Id := N + 318; + Name_UBA : constant Name_Id := N + 319; + Name_UBS : constant Name_Id := N + 320; + Name_UBSB : constant Name_Id := N + 321; + Name_Unit_Name : constant Name_Id := N + 322; + Name_Unknown : constant Name_Id := N + 323; + Name_Unrestricted : constant Name_Id := N + 324; + Name_Uppercase : constant Name_Id := N + 325; + Name_User : constant Name_Id := N + 326; + Name_VAX_Float : constant Name_Id := N + 327; + Name_VMS : constant Name_Id := N + 328; + Name_Working_Storage : constant Name_Id := N + 329; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -593,158 +598,158 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 325; - Name_Abort_Signal : constant Name_Id := N + 325; -- GNAT - Name_Access : constant Name_Id := N + 326; - Name_Address : constant Name_Id := N + 327; - Name_Address_Size : constant Name_Id := N + 328; -- GNAT - Name_Aft : constant Name_Id := N + 329; - Name_Alignment : constant Name_Id := N + 330; - Name_Asm_Input : constant Name_Id := N + 331; -- GNAT - Name_Asm_Output : constant Name_Id := N + 332; -- GNAT - Name_AST_Entry : constant Name_Id := N + 333; -- VMS - Name_Bit : constant Name_Id := N + 334; -- GNAT - Name_Bit_Order : constant Name_Id := N + 335; - Name_Bit_Position : constant Name_Id := N + 336; -- GNAT - Name_Body_Version : constant Name_Id := N + 337; - Name_Callable : constant Name_Id := N + 338; - Name_Caller : constant Name_Id := N + 339; - Name_Code_Address : constant Name_Id := N + 340; -- GNAT - Name_Component_Size : constant Name_Id := N + 341; - Name_Compose : constant Name_Id := N + 342; - Name_Constrained : constant Name_Id := N + 343; - Name_Count : constant Name_Id := N + 344; - Name_Default_Bit_Order : constant Name_Id := N + 345; -- GNAT - Name_Definite : constant Name_Id := N + 346; - Name_Delta : constant Name_Id := N + 347; - Name_Denorm : constant Name_Id := N + 348; - Name_Digits : constant Name_Id := N + 349; - Name_Elaborated : constant Name_Id := N + 350; -- GNAT - Name_Emax : constant Name_Id := N + 351; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 352; -- GNAT - Name_Epsilon : constant Name_Id := N + 353; -- Ada 83 - Name_Exponent : constant Name_Id := N + 354; - Name_External_Tag : constant Name_Id := N + 355; - Name_First : constant Name_Id := N + 356; - Name_First_Bit : constant Name_Id := N + 357; - Name_Fixed_Value : constant Name_Id := N + 358; -- GNAT - Name_Fore : constant Name_Id := N + 359; - Name_Has_Discriminants : constant Name_Id := N + 360; -- GNAT - Name_Identity : constant Name_Id := N + 361; - Name_Img : constant Name_Id := N + 362; -- GNAT - Name_Integer_Value : constant Name_Id := N + 363; -- GNAT - Name_Large : constant Name_Id := N + 364; -- Ada 83 - Name_Last : constant Name_Id := N + 365; - Name_Last_Bit : constant Name_Id := N + 366; - Name_Leading_Part : constant Name_Id := N + 367; - Name_Length : constant Name_Id := N + 368; - Name_Machine_Emax : constant Name_Id := N + 369; - Name_Machine_Emin : constant Name_Id := N + 370; - Name_Machine_Mantissa : constant Name_Id := N + 371; - Name_Machine_Overflows : constant Name_Id := N + 372; - Name_Machine_Radix : constant Name_Id := N + 373; - Name_Machine_Rounds : constant Name_Id := N + 374; - Name_Machine_Size : constant Name_Id := N + 375; -- GNAT - Name_Mantissa : constant Name_Id := N + 376; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 377; - Name_Maximum_Alignment : constant Name_Id := N + 378; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 379; -- GNAT - Name_Model_Emin : constant Name_Id := N + 380; - Name_Model_Epsilon : constant Name_Id := N + 381; - Name_Model_Mantissa : constant Name_Id := N + 382; - Name_Model_Small : constant Name_Id := N + 383; - Name_Modulus : constant Name_Id := N + 384; - Name_Null_Parameter : constant Name_Id := N + 385; -- GNAT - Name_Object_Size : constant Name_Id := N + 386; -- GNAT - Name_Partition_ID : constant Name_Id := N + 387; - Name_Passed_By_Reference : constant Name_Id := N + 388; -- GNAT - Name_Pool_Address : constant Name_Id := N + 389; - Name_Pos : constant Name_Id := N + 390; - Name_Position : constant Name_Id := N + 391; - Name_Range : constant Name_Id := N + 392; - Name_Range_Length : constant Name_Id := N + 393; -- GNAT - Name_Round : constant Name_Id := N + 394; - Name_Safe_Emax : constant Name_Id := N + 395; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 396; - Name_Safe_Large : constant Name_Id := N + 397; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 398; - Name_Safe_Small : constant Name_Id := N + 399; -- Ada 83 - Name_Scale : constant Name_Id := N + 400; - Name_Scaling : constant Name_Id := N + 401; - Name_Signed_Zeros : constant Name_Id := N + 402; - Name_Size : constant Name_Id := N + 403; - Name_Small : constant Name_Id := N + 404; - Name_Storage_Size : constant Name_Id := N + 405; - Name_Storage_Unit : constant Name_Id := N + 406; -- GNAT - Name_Tag : constant Name_Id := N + 407; - Name_Target_Name : constant Name_Id := N + 408; -- GNAT - Name_Terminated : constant Name_Id := N + 409; - Name_To_Address : constant Name_Id := N + 410; -- GNAT - Name_Type_Class : constant Name_Id := N + 411; -- GNAT - Name_UET_Address : constant Name_Id := N + 412; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 413; - Name_Unchecked_Access : constant Name_Id := N + 414; - Name_Unconstrained_Array : constant Name_Id := N + 415; - Name_Universal_Literal_String : constant Name_Id := N + 416; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 417; -- GNAT - Name_VADS_Size : constant Name_Id := N + 418; -- GNAT - Name_Val : constant Name_Id := N + 419; - Name_Valid : constant Name_Id := N + 420; - Name_Value_Size : constant Name_Id := N + 421; -- GNAT - Name_Version : constant Name_Id := N + 422; - Name_Wchar_T_Size : constant Name_Id := N + 423; -- GNAT - Name_Wide_Width : constant Name_Id := N + 424; - Name_Width : constant Name_Id := N + 425; - Name_Word_Size : constant Name_Id := N + 426; -- GNAT + First_Attribute_Name : constant Name_Id := N + 330; + Name_Abort_Signal : constant Name_Id := N + 330; -- GNAT + Name_Access : constant Name_Id := N + 331; + Name_Address : constant Name_Id := N + 332; + Name_Address_Size : constant Name_Id := N + 333; -- GNAT + Name_Aft : constant Name_Id := N + 334; + Name_Alignment : constant Name_Id := N + 335; + Name_Asm_Input : constant Name_Id := N + 336; -- GNAT + Name_Asm_Output : constant Name_Id := N + 337; -- GNAT + Name_AST_Entry : constant Name_Id := N + 338; -- VMS + Name_Bit : constant Name_Id := N + 339; -- GNAT + Name_Bit_Order : constant Name_Id := N + 340; + Name_Bit_Position : constant Name_Id := N + 341; -- GNAT + Name_Body_Version : constant Name_Id := N + 342; + Name_Callable : constant Name_Id := N + 343; + Name_Caller : constant Name_Id := N + 344; + Name_Code_Address : constant Name_Id := N + 345; -- GNAT + Name_Component_Size : constant Name_Id := N + 346; + Name_Compose : constant Name_Id := N + 347; + Name_Constrained : constant Name_Id := N + 348; + Name_Count : constant Name_Id := N + 349; + Name_Default_Bit_Order : constant Name_Id := N + 350; -- GNAT + Name_Definite : constant Name_Id := N + 351; + Name_Delta : constant Name_Id := N + 352; + Name_Denorm : constant Name_Id := N + 353; + Name_Digits : constant Name_Id := N + 354; + Name_Elaborated : constant Name_Id := N + 355; -- GNAT + Name_Emax : constant Name_Id := N + 356; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 357; -- GNAT + Name_Epsilon : constant Name_Id := N + 358; -- Ada 83 + Name_Exponent : constant Name_Id := N + 359; + Name_External_Tag : constant Name_Id := N + 360; + Name_First : constant Name_Id := N + 361; + Name_First_Bit : constant Name_Id := N + 362; + Name_Fixed_Value : constant Name_Id := N + 363; -- GNAT + Name_Fore : constant Name_Id := N + 364; + Name_Has_Discriminants : constant Name_Id := N + 365; -- GNAT + Name_Identity : constant Name_Id := N + 366; + Name_Img : constant Name_Id := N + 367; -- GNAT + Name_Integer_Value : constant Name_Id := N + 368; -- GNAT + Name_Large : constant Name_Id := N + 369; -- Ada 83 + Name_Last : constant Name_Id := N + 370; + Name_Last_Bit : constant Name_Id := N + 371; + Name_Leading_Part : constant Name_Id := N + 372; + Name_Length : constant Name_Id := N + 373; + Name_Machine_Emax : constant Name_Id := N + 374; + Name_Machine_Emin : constant Name_Id := N + 375; + Name_Machine_Mantissa : constant Name_Id := N + 376; + Name_Machine_Overflows : constant Name_Id := N + 377; + Name_Machine_Radix : constant Name_Id := N + 378; + Name_Machine_Rounds : constant Name_Id := N + 379; + Name_Machine_Size : constant Name_Id := N + 380; -- GNAT + Name_Mantissa : constant Name_Id := N + 381; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 382; + Name_Maximum_Alignment : constant Name_Id := N + 383; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 384; -- GNAT + Name_Model_Emin : constant Name_Id := N + 385; + Name_Model_Epsilon : constant Name_Id := N + 386; + Name_Model_Mantissa : constant Name_Id := N + 387; + Name_Model_Small : constant Name_Id := N + 388; + Name_Modulus : constant Name_Id := N + 389; + Name_Null_Parameter : constant Name_Id := N + 390; -- GNAT + Name_Object_Size : constant Name_Id := N + 391; -- GNAT + Name_Partition_ID : constant Name_Id := N + 392; + Name_Passed_By_Reference : constant Name_Id := N + 393; -- GNAT + Name_Pool_Address : constant Name_Id := N + 394; + Name_Pos : constant Name_Id := N + 395; + Name_Position : constant Name_Id := N + 396; + Name_Range : constant Name_Id := N + 397; + Name_Range_Length : constant Name_Id := N + 398; -- GNAT + Name_Round : constant Name_Id := N + 399; + Name_Safe_Emax : constant Name_Id := N + 400; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 401; + Name_Safe_Large : constant Name_Id := N + 402; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 403; + Name_Safe_Small : constant Name_Id := N + 404; -- Ada 83 + Name_Scale : constant Name_Id := N + 405; + Name_Scaling : constant Name_Id := N + 406; + Name_Signed_Zeros : constant Name_Id := N + 407; + Name_Size : constant Name_Id := N + 408; + Name_Small : constant Name_Id := N + 409; + Name_Storage_Size : constant Name_Id := N + 410; + Name_Storage_Unit : constant Name_Id := N + 411; -- GNAT + Name_Tag : constant Name_Id := N + 412; + Name_Target_Name : constant Name_Id := N + 413; -- GNAT + Name_Terminated : constant Name_Id := N + 414; + Name_To_Address : constant Name_Id := N + 415; -- GNAT + Name_Type_Class : constant Name_Id := N + 416; -- GNAT + Name_UET_Address : constant Name_Id := N + 417; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 418; + Name_Unchecked_Access : constant Name_Id := N + 419; + Name_Unconstrained_Array : constant Name_Id := N + 420; + Name_Universal_Literal_String : constant Name_Id := N + 421; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 422; -- GNAT + Name_VADS_Size : constant Name_Id := N + 423; -- GNAT + Name_Val : constant Name_Id := N + 424; + Name_Valid : constant Name_Id := N + 425; + Name_Value_Size : constant Name_Id := N + 426; -- GNAT + Name_Version : constant Name_Id := N + 427; + Name_Wchar_T_Size : constant Name_Id := N + 428; -- GNAT + Name_Wide_Width : constant Name_Id := N + 429; + Name_Width : constant Name_Id := N + 430; + Name_Word_Size : constant Name_Id := N + 431; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value. - First_Renamable_Function_Attribute : constant Name_Id := N + 427; - Name_Adjacent : constant Name_Id := N + 427; - Name_Ceiling : constant Name_Id := N + 428; - Name_Copy_Sign : constant Name_Id := N + 429; - Name_Floor : constant Name_Id := N + 430; - Name_Fraction : constant Name_Id := N + 431; - Name_Image : constant Name_Id := N + 432; - Name_Input : constant Name_Id := N + 433; - Name_Machine : constant Name_Id := N + 434; - Name_Max : constant Name_Id := N + 435; - Name_Min : constant Name_Id := N + 436; - Name_Model : constant Name_Id := N + 437; - Name_Pred : constant Name_Id := N + 438; - Name_Remainder : constant Name_Id := N + 439; - Name_Rounding : constant Name_Id := N + 440; - Name_Succ : constant Name_Id := N + 441; - Name_Truncation : constant Name_Id := N + 442; - Name_Value : constant Name_Id := N + 443; - Name_Wide_Image : constant Name_Id := N + 444; - Name_Wide_Value : constant Name_Id := N + 445; - Last_Renamable_Function_Attribute : constant Name_Id := N + 445; + First_Renamable_Function_Attribute : constant Name_Id := N + 432; + Name_Adjacent : constant Name_Id := N + 432; + Name_Ceiling : constant Name_Id := N + 433; + Name_Copy_Sign : constant Name_Id := N + 434; + Name_Floor : constant Name_Id := N + 435; + Name_Fraction : constant Name_Id := N + 436; + Name_Image : constant Name_Id := N + 437; + Name_Input : constant Name_Id := N + 438; + Name_Machine : constant Name_Id := N + 439; + Name_Max : constant Name_Id := N + 440; + Name_Min : constant Name_Id := N + 441; + Name_Model : constant Name_Id := N + 442; + Name_Pred : constant Name_Id := N + 443; + Name_Remainder : constant Name_Id := N + 444; + Name_Rounding : constant Name_Id := N + 445; + Name_Succ : constant Name_Id := N + 446; + Name_Truncation : constant Name_Id := N + 447; + Name_Value : constant Name_Id := N + 448; + Name_Wide_Image : constant Name_Id := N + 449; + Name_Wide_Value : constant Name_Id := N + 450; + Last_Renamable_Function_Attribute : constant Name_Id := N + 450; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 446; - Name_Output : constant Name_Id := N + 446; - Name_Read : constant Name_Id := N + 447; - Name_Write : constant Name_Id := N + 448; - Last_Procedure_Attribute : constant Name_Id := N + 448; + First_Procedure_Attribute : constant Name_Id := N + 451; + Name_Output : constant Name_Id := N + 451; + Name_Read : constant Name_Id := N + 452; + Name_Write : constant Name_Id := N + 453; + Last_Procedure_Attribute : constant Name_Id := N + 453; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 449; - Name_Elab_Body : constant Name_Id := N + 449; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 450; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 451; + First_Entity_Attribute_Name : constant Name_Id := N + 454; + Name_Elab_Body : constant Name_Id := N + 454; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 455; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 456; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 452; - Name_Base : constant Name_Id := N + 452; - Name_Class : constant Name_Id := N + 453; - Last_Type_Attribute_Name : constant Name_Id := N + 453; - Last_Entity_Attribute_Name : constant Name_Id := N + 453; - Last_Attribute_Name : constant Name_Id := N + 453; + First_Type_Attribute_Name : constant Name_Id := N + 457; + Name_Base : constant Name_Id := N + 457; + Name_Class : constant Name_Id := N + 458; + Last_Type_Attribute_Name : constant Name_Id := N + 458; + Last_Entity_Attribute_Name : constant Name_Id := N + 458; + Last_Attribute_Name : constant Name_Id := N + 458; -- Names of recognized locking policy identifiers @@ -752,10 +757,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 454; - Name_Ceiling_Locking : constant Name_Id := N + 454; - Name_Inheritance_Locking : constant Name_Id := N + 455; - Last_Locking_Policy_Name : constant Name_Id := N + 455; + First_Locking_Policy_Name : constant Name_Id := N + 459; + Name_Ceiling_Locking : constant Name_Id := N + 459; + Name_Inheritance_Locking : constant Name_Id := N + 460; + Last_Locking_Policy_Name : constant Name_Id := N + 460; -- Names of recognized queuing policy identifiers. @@ -763,10 +768,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 456; - Name_FIFO_Queuing : constant Name_Id := N + 456; - Name_Priority_Queuing : constant Name_Id := N + 457; - Last_Queuing_Policy_Name : constant Name_Id := N + 457; + First_Queuing_Policy_Name : constant Name_Id := N + 461; + Name_FIFO_Queuing : constant Name_Id := N + 461; + Name_Priority_Queuing : constant Name_Id := N + 462; + Last_Queuing_Policy_Name : constant Name_Id := N + 462; -- Names of recognized task dispatching policy identifiers @@ -774,193 +779,193 @@ package Snames is -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 458; - Name_FIFO_Within_Priorities : constant Name_Id := N + 458; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 458; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 463; + Name_FIFO_Within_Priorities : constant Name_Id := N + 463; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 463; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 459; - Name_Access_Check : constant Name_Id := N + 459; - Name_Accessibility_Check : constant Name_Id := N + 460; - Name_Discriminant_Check : constant Name_Id := N + 461; - Name_Division_Check : constant Name_Id := N + 462; - Name_Elaboration_Check : constant Name_Id := N + 463; - Name_Index_Check : constant Name_Id := N + 464; - Name_Length_Check : constant Name_Id := N + 465; - Name_Overflow_Check : constant Name_Id := N + 466; - Name_Range_Check : constant Name_Id := N + 467; - Name_Storage_Check : constant Name_Id := N + 468; - Name_Tag_Check : constant Name_Id := N + 469; - Name_All_Checks : constant Name_Id := N + 470; - Last_Check_Name : constant Name_Id := N + 470; + First_Check_Name : constant Name_Id := N + 464; + Name_Access_Check : constant Name_Id := N + 464; + Name_Accessibility_Check : constant Name_Id := N + 465; + Name_Discriminant_Check : constant Name_Id := N + 466; + Name_Division_Check : constant Name_Id := N + 467; + Name_Elaboration_Check : constant Name_Id := N + 468; + Name_Index_Check : constant Name_Id := N + 469; + Name_Length_Check : constant Name_Id := N + 470; + Name_Overflow_Check : constant Name_Id := N + 471; + Name_Range_Check : constant Name_Id := N + 472; + Name_Storage_Check : constant Name_Id := N + 473; + Name_Tag_Check : constant Name_Id := N + 474; + Name_All_Checks : constant Name_Id := N + 475; + Last_Check_Name : constant Name_Id := N + 475; -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Range). - Name_Abort : constant Name_Id := N + 471; - Name_Abs : constant Name_Id := N + 472; - Name_Accept : constant Name_Id := N + 473; - Name_And : constant Name_Id := N + 474; - Name_All : constant Name_Id := N + 475; - Name_Array : constant Name_Id := N + 476; - Name_At : constant Name_Id := N + 477; - Name_Begin : constant Name_Id := N + 478; - Name_Body : constant Name_Id := N + 479; - Name_Case : constant Name_Id := N + 480; - Name_Constant : constant Name_Id := N + 481; - Name_Declare : constant Name_Id := N + 482; - Name_Delay : constant Name_Id := N + 483; - Name_Do : constant Name_Id := N + 484; - Name_Else : constant Name_Id := N + 485; - Name_Elsif : constant Name_Id := N + 486; - Name_End : constant Name_Id := N + 487; - Name_Entry : constant Name_Id := N + 488; - Name_Exception : constant Name_Id := N + 489; - Name_Exit : constant Name_Id := N + 490; - Name_For : constant Name_Id := N + 491; - Name_Function : constant Name_Id := N + 492; - Name_Generic : constant Name_Id := N + 493; - Name_Goto : constant Name_Id := N + 494; - Name_If : constant Name_Id := N + 495; - Name_In : constant Name_Id := N + 496; - Name_Is : constant Name_Id := N + 497; - Name_Limited : constant Name_Id := N + 498; - Name_Loop : constant Name_Id := N + 499; - Name_Mod : constant Name_Id := N + 500; - Name_New : constant Name_Id := N + 501; - Name_Not : constant Name_Id := N + 502; - Name_Null : constant Name_Id := N + 503; - Name_Of : constant Name_Id := N + 504; - Name_Or : constant Name_Id := N + 505; - Name_Others : constant Name_Id := N + 506; - Name_Out : constant Name_Id := N + 507; - Name_Package : constant Name_Id := N + 508; - Name_Pragma : constant Name_Id := N + 509; - Name_Private : constant Name_Id := N + 510; - Name_Procedure : constant Name_Id := N + 511; - Name_Raise : constant Name_Id := N + 512; - Name_Record : constant Name_Id := N + 513; - Name_Rem : constant Name_Id := N + 514; - Name_Renames : constant Name_Id := N + 515; - Name_Return : constant Name_Id := N + 516; - Name_Reverse : constant Name_Id := N + 517; - Name_Select : constant Name_Id := N + 518; - Name_Separate : constant Name_Id := N + 519; - Name_Subtype : constant Name_Id := N + 520; - Name_Task : constant Name_Id := N + 521; - Name_Terminate : constant Name_Id := N + 522; - Name_Then : constant Name_Id := N + 523; - Name_Type : constant Name_Id := N + 524; - Name_Use : constant Name_Id := N + 525; - Name_When : constant Name_Id := N + 526; - Name_While : constant Name_Id := N + 527; - Name_With : constant Name_Id := N + 528; - Name_Xor : constant Name_Id := N + 529; + Name_Abort : constant Name_Id := N + 476; + Name_Abs : constant Name_Id := N + 477; + Name_Accept : constant Name_Id := N + 478; + Name_And : constant Name_Id := N + 479; + Name_All : constant Name_Id := N + 480; + Name_Array : constant Name_Id := N + 481; + Name_At : constant Name_Id := N + 482; + Name_Begin : constant Name_Id := N + 483; + Name_Body : constant Name_Id := N + 484; + Name_Case : constant Name_Id := N + 485; + Name_Constant : constant Name_Id := N + 486; + Name_Declare : constant Name_Id := N + 487; + Name_Delay : constant Name_Id := N + 488; + Name_Do : constant Name_Id := N + 489; + Name_Else : constant Name_Id := N + 490; + Name_Elsif : constant Name_Id := N + 491; + Name_End : constant Name_Id := N + 492; + Name_Entry : constant Name_Id := N + 493; + Name_Exception : constant Name_Id := N + 494; + Name_Exit : constant Name_Id := N + 495; + Name_For : constant Name_Id := N + 496; + Name_Function : constant Name_Id := N + 497; + Name_Generic : constant Name_Id := N + 498; + Name_Goto : constant Name_Id := N + 499; + Name_If : constant Name_Id := N + 500; + Name_In : constant Name_Id := N + 501; + Name_Is : constant Name_Id := N + 502; + Name_Limited : constant Name_Id := N + 503; + Name_Loop : constant Name_Id := N + 504; + Name_Mod : constant Name_Id := N + 505; + Name_New : constant Name_Id := N + 506; + Name_Not : constant Name_Id := N + 507; + Name_Null : constant Name_Id := N + 508; + Name_Of : constant Name_Id := N + 509; + Name_Or : constant Name_Id := N + 510; + Name_Others : constant Name_Id := N + 511; + Name_Out : constant Name_Id := N + 512; + Name_Package : constant Name_Id := N + 513; + Name_Pragma : constant Name_Id := N + 514; + Name_Private : constant Name_Id := N + 515; + Name_Procedure : constant Name_Id := N + 516; + Name_Raise : constant Name_Id := N + 517; + Name_Record : constant Name_Id := N + 518; + Name_Rem : constant Name_Id := N + 519; + Name_Renames : constant Name_Id := N + 520; + Name_Return : constant Name_Id := N + 521; + Name_Reverse : constant Name_Id := N + 522; + Name_Select : constant Name_Id := N + 523; + Name_Separate : constant Name_Id := N + 524; + Name_Subtype : constant Name_Id := N + 525; + Name_Task : constant Name_Id := N + 526; + Name_Terminate : constant Name_Id := N + 527; + Name_Then : constant Name_Id := N + 528; + Name_Type : constant Name_Id := N + 529; + Name_Use : constant Name_Id := N + 530; + Name_When : constant Name_Id := N + 531; + Name_While : constant Name_Id := N + 532; + Name_With : constant Name_Id := N + 533; + Name_Xor : constant Name_Id := N + 534; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Adress, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 530; - Name_Divide : constant Name_Id := N + 530; - Name_Enclosing_Entity : constant Name_Id := N + 531; - Name_Exception_Information : constant Name_Id := N + 532; - Name_Exception_Message : constant Name_Id := N + 533; - Name_Exception_Name : constant Name_Id := N + 534; - Name_File : constant Name_Id := N + 535; - Name_Import_Address : constant Name_Id := N + 536; - Name_Import_Largest_Value : constant Name_Id := N + 537; - Name_Import_Value : constant Name_Id := N + 538; - Name_Is_Negative : constant Name_Id := N + 539; - Name_Line : constant Name_Id := N + 540; - Name_Rotate_Left : constant Name_Id := N + 541; - Name_Rotate_Right : constant Name_Id := N + 542; - Name_Shift_Left : constant Name_Id := N + 543; - Name_Shift_Right : constant Name_Id := N + 544; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 545; - Name_Source_Location : constant Name_Id := N + 546; - Name_Unchecked_Conversion : constant Name_Id := N + 547; - Name_Unchecked_Deallocation : constant Name_Id := N + 548; - Name_To_Pointer : constant Name_Id := N + 549; - Last_Intrinsic_Name : constant Name_Id := N + 549; + First_Intrinsic_Name : constant Name_Id := N + 535; + Name_Divide : constant Name_Id := N + 535; + Name_Enclosing_Entity : constant Name_Id := N + 536; + Name_Exception_Information : constant Name_Id := N + 537; + Name_Exception_Message : constant Name_Id := N + 538; + Name_Exception_Name : constant Name_Id := N + 539; + Name_File : constant Name_Id := N + 540; + Name_Import_Address : constant Name_Id := N + 541; + Name_Import_Largest_Value : constant Name_Id := N + 542; + Name_Import_Value : constant Name_Id := N + 543; + Name_Is_Negative : constant Name_Id := N + 544; + Name_Line : constant Name_Id := N + 545; + Name_Rotate_Left : constant Name_Id := N + 546; + Name_Rotate_Right : constant Name_Id := N + 547; + Name_Shift_Left : constant Name_Id := N + 548; + Name_Shift_Right : constant Name_Id := N + 549; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 550; + Name_Source_Location : constant Name_Id := N + 551; + Name_Unchecked_Conversion : constant Name_Id := N + 552; + Name_Unchecked_Deallocation : constant Name_Id := N + 553; + Name_To_Pointer : constant Name_Id := N + 554; + Last_Intrinsic_Name : constant Name_Id := N + 554; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 550; - Name_Abstract : constant Name_Id := N + 550; - Name_Aliased : constant Name_Id := N + 551; - Name_Protected : constant Name_Id := N + 552; - Name_Until : constant Name_Id := N + 553; - Name_Requeue : constant Name_Id := N + 554; - Name_Tagged : constant Name_Id := N + 555; - Last_95_Reserved_Word : constant Name_Id := N + 555; + First_95_Reserved_Word : constant Name_Id := N + 555; + Name_Abstract : constant Name_Id := N + 555; + Name_Aliased : constant Name_Id := N + 556; + Name_Protected : constant Name_Id := N + 557; + Name_Until : constant Name_Id := N + 558; + Name_Requeue : constant Name_Id := N + 559; + Name_Tagged : constant Name_Id := N + 560; + Last_95_Reserved_Word : constant Name_Id := N + 560; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 556; + Name_Raise_Exception : constant Name_Id := N + 561; -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 557; - Name_Body_Suffix : constant Name_Id := N + 558; - Name_Builder : constant Name_Id := N + 559; - Name_Compiler : constant Name_Id := N + 560; - Name_Cross_Reference : constant Name_Id := N + 561; - Name_Default_Switches : constant Name_Id := N + 562; - Name_Exec_Dir : constant Name_Id := N + 563; - Name_Executable : constant Name_Id := N + 564; - Name_Executable_Suffix : constant Name_Id := N + 565; - Name_Extends : constant Name_Id := N + 566; - Name_Finder : constant Name_Id := N + 567; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 568; - Name_Gnatls : constant Name_Id := N + 569; - Name_Gnatstub : constant Name_Id := N + 570; - Name_Implementation : constant Name_Id := N + 571; - Name_Implementation_Exceptions : constant Name_Id := N + 572; - Name_Implementation_Suffix : constant Name_Id := N + 573; - Name_Languages : constant Name_Id := N + 574; - Name_Library_Dir : constant Name_Id := N + 575; - Name_Library_Auto_Init : constant Name_Id := N + 576; - Name_Library_GCC : constant Name_Id := N + 577; - Name_Library_Interface : constant Name_Id := N + 578; - Name_Library_Kind : constant Name_Id := N + 579; - Name_Library_Name : constant Name_Id := N + 580; - Name_Library_Options : constant Name_Id := N + 581; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 582; - Name_Library_Src_Dir : constant Name_Id := N + 583; - Name_Library_Symbol_File : constant Name_Id := N + 584; - Name_Library_Symbol_Policy : constant Name_Id := N + 585; - Name_Library_Version : constant Name_Id := N + 586; - Name_Linker : constant Name_Id := N + 587; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 588; - Name_Locally_Removed_Files : constant Name_Id := N + 589; - Name_Naming : constant Name_Id := N + 590; - Name_Object_Dir : constant Name_Id := N + 591; - Name_Pretty_Printer : constant Name_Id := N + 592; - Name_Project : constant Name_Id := N + 593; - Name_Separate_Suffix : constant Name_Id := N + 594; - Name_Source_Dirs : constant Name_Id := N + 595; - Name_Source_Files : constant Name_Id := N + 596; - Name_Source_List_File : constant Name_Id := N + 597; - Name_Spec : constant Name_Id := N + 598; - Name_Spec_Suffix : constant Name_Id := N + 599; - Name_Specification : constant Name_Id := N + 600; - Name_Specification_Exceptions : constant Name_Id := N + 601; - Name_Specification_Suffix : constant Name_Id := N + 602; - Name_Switches : constant Name_Id := N + 603; + Name_Binder : constant Name_Id := N + 562; + Name_Body_Suffix : constant Name_Id := N + 563; + Name_Builder : constant Name_Id := N + 564; + Name_Compiler : constant Name_Id := N + 565; + Name_Cross_Reference : constant Name_Id := N + 566; + Name_Default_Switches : constant Name_Id := N + 567; + Name_Exec_Dir : constant Name_Id := N + 568; + Name_Executable : constant Name_Id := N + 569; + Name_Executable_Suffix : constant Name_Id := N + 570; + Name_Extends : constant Name_Id := N + 571; + Name_Finder : constant Name_Id := N + 572; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 573; + Name_Gnatls : constant Name_Id := N + 574; + Name_Gnatstub : constant Name_Id := N + 575; + Name_Implementation : constant Name_Id := N + 576; + Name_Implementation_Exceptions : constant Name_Id := N + 577; + Name_Implementation_Suffix : constant Name_Id := N + 578; + Name_Languages : constant Name_Id := N + 579; + Name_Library_Dir : constant Name_Id := N + 580; + Name_Library_Auto_Init : constant Name_Id := N + 581; + Name_Library_GCC : constant Name_Id := N + 582; + Name_Library_Interface : constant Name_Id := N + 583; + Name_Library_Kind : constant Name_Id := N + 584; + Name_Library_Name : constant Name_Id := N + 585; + Name_Library_Options : constant Name_Id := N + 586; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 587; + Name_Library_Src_Dir : constant Name_Id := N + 588; + Name_Library_Symbol_File : constant Name_Id := N + 589; + Name_Library_Symbol_Policy : constant Name_Id := N + 590; + Name_Library_Version : constant Name_Id := N + 591; + Name_Linker : constant Name_Id := N + 592; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 593; + Name_Locally_Removed_Files : constant Name_Id := N + 594; + Name_Naming : constant Name_Id := N + 595; + Name_Object_Dir : constant Name_Id := N + 596; + Name_Pretty_Printer : constant Name_Id := N + 597; + Name_Project : constant Name_Id := N + 598; + Name_Separate_Suffix : constant Name_Id := N + 599; + Name_Source_Dirs : constant Name_Id := N + 600; + Name_Source_Files : constant Name_Id := N + 601; + Name_Source_List_File : constant Name_Id := N + 602; + Name_Spec : constant Name_Id := N + 603; + Name_Spec_Suffix : constant Name_Id := N + 604; + Name_Specification : constant Name_Id := N + 605; + Name_Specification_Exceptions : constant Name_Id := N + 606; + Name_Specification_Suffix : constant Name_Id := N + 607; + Name_Switches : constant Name_Id := N + 608; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 604; + Name_Unaligned_Valid : constant Name_Id := N + 609; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 604; + Last_Predefined_Name : constant Name_Id := N + 609; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 117a95360dc..c9286121ee3 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -83,6 +83,13 @@ int type_annotate_only; over GC. */ tree gnu_block_stack; +/* The current BLOCK_STMT node. TREE_CHAIN points to the previous + BLOCK_STMT node. */ +static GTY(()) tree gnu_block_stmt_node; + +/* List of unused BLOCK_STMT nodes. */ +static GTY((deletable)) tree gnu_block_stmt_free_list; + /* List of TREE_LIST nodes representing a stack of exception pointer variables. TREE_VALUE is the VAR_DECL that stores the address of the raised exception. Nonzero means we are in an exception @@ -105,6 +112,8 @@ static GTY(()) tree gnu_return_label_stack; static tree tree_transform (Node_Id); static rtx first_nondeleted_insn (rtx); +static tree start_block_stmt (void); +static tree end_block_stmt (void); static tree build_block_stmt (List_Id); static tree make_expr_stmt_from_rtl (rtx, Node_Id); static void elaborate_all_entities (Node_Id); @@ -186,6 +195,7 @@ gigi (Node_Id gnat_root, init_dummy_type (); init_code_table (); gnat_compute_largest_alignment (); + start_block_stmt (); /* Enable GNAT stack checking method if needed */ if (!Stack_Check_Probes_On_Target) @@ -237,12 +247,16 @@ gnat_to_code (Node_Id gnat_node) /* Save node number in case error */ error_gnat_node = gnat_node; + start_block_stmt (); gnu_root = tree_transform (gnat_node); + gnat_expand_stmt (end_block_stmt ()); /* If we return a statement, generate code for it. */ if (IS_STMT (gnu_root)) - expand_expr_stmt (gnu_root); - + { + if (TREE_CODE (gnu_root) != NULL_STMT) + gnat_expand_stmt (gnu_root); + } /* This should just generate code, not return a value. If it returns a value, something is wrong. */ else if (gnu_root != error_mark_node) @@ -275,7 +289,9 @@ gnat_to_gnu (Node_Id gnat_node) /* Save node number in case error */ error_gnat_node = gnat_node; + start_block_stmt (); gnu_root = tree_transform (gnat_node); + gnat_expand_stmt (end_block_stmt ()); if (gnu_root == error_mark_node) { @@ -808,10 +824,14 @@ tree_transform (Node_Id gnat_node) { if ((Is_Public (gnat_temp) || global_bindings_p ()) && ! TREE_CONSTANT (gnu_expr)) - gnu_expr - = create_var_decl (create_concat_name (gnat_temp, "init"), - NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, - 0, Is_Public (gnat_temp), 0, 0, 0); + { + gnu_expr + = create_var_decl (create_concat_name (gnat_temp, "init"), + NULL_TREE, TREE_TYPE (gnu_expr), + gnu_expr, 0, Is_Public (gnat_temp), 0, + 0, 0); + add_decl_stmt (gnu_expr, gnat_temp); + } else gnu_expr = maybe_variable (gnu_expr, Expression (gnat_node)); @@ -841,10 +861,8 @@ tree_transform (Node_Id gnat_node) && (Is_Array_Type (Etype (gnat_temp)) || Is_Record_Type (Etype (gnat_temp)) || Is_Concurrent_Type (Etype (gnat_temp))))) - { - gnu_expr = gnat_to_gnu (Renamed_Object (gnat_temp)); - gnat_to_gnu_entity (gnat_temp, gnu_expr, 1); - } + gnat_to_gnu_entity (gnat_temp, + gnat_to_gnu (Renamed_Object (gnat_temp)), 1); break; case N_Implicit_Label_Declaration: @@ -2083,6 +2101,7 @@ tree_transform (Node_Id gnat_node) break; case N_Null_Statement: + gnu_result = build_nt (NULL_STMT); break; case N_Assignment_Statement: @@ -2255,7 +2274,7 @@ tree_transform (Node_Id gnat_node) variables are declared since we want them to be local to this set of statements instead of the block containing the Case statement. */ - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (0); for (gnat_statement = First (Statements (gnat_when)); Present (gnat_statement); @@ -2265,8 +2284,8 @@ tree_transform (Node_Id gnat_node) /* Communicate to GCC that we are done with the current WHEN, i.e. insert a "break" statement. */ expand_exit_something (); - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); } expand_end_case (gnu_expr); @@ -2334,11 +2353,13 @@ tree_transform (Node_Id gnat_node) /* Open a new nesting level that will surround the loop to declare the loop index variable. */ - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (0); /* Declare the loop index and set it to its initial value. */ + start_block_stmt (); gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1); + expand_expr_stmt (end_block_stmt ()); if (DECL_BY_REF_P (gnu_loop_var)) gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var); @@ -2394,7 +2415,7 @@ tree_transform (Node_Id gnat_node) storage will be released every iteration. This is needed for stack allocation. */ - pushlevel (0); + gnat_pushlevel (); gnu_block_stack = tree_cons (gnu_bottom_condition, NULL_TREE, gnu_block_stack); expand_start_bindings (0); @@ -2404,8 +2425,8 @@ tree_transform (Node_Id gnat_node) gnat_statement = Next (gnat_statement)) gnat_to_code (gnat_statement); - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); gnu_block_stack = TREE_CHAIN (gnu_block_stack); set_lineno (gnat_node, 1); @@ -2430,8 +2451,8 @@ tree_transform (Node_Id gnat_node) /* Close the nesting level that sourround the loop that was used to declare the loop index variable. */ set_lineno (gnat_node, 1); - expand_end_bindings (NULL_TREE, 1, -1); - poplevel (1, 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); } if (enclosing_if_p) @@ -2443,13 +2464,15 @@ tree_transform (Node_Id gnat_node) break; case N_Block_Statement: - pushlevel (0); + gnat_pushlevel (); gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); expand_start_bindings (0); + start_block_stmt (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); gnat_to_code (Handled_Statement_Sequence (gnat_node)); - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); gnu_block_stack = TREE_CHAIN (gnu_block_stack); if (Present (Identifier (gnat_node))) mark_out_of_scope (Entity (Identifier (gnat_node))); @@ -2678,9 +2701,10 @@ tree_transform (Node_Id gnat_node) result in having the first line of the subprogram counted twice by gcov. */ - pushlevel (0); + gnat_pushlevel (); gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); expand_start_bindings (0); + start_block_stmt (); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); @@ -2695,7 +2719,7 @@ tree_transform (Node_Id gnat_node) = tree_cons (NULL_TREE, build_decl (LABEL_DECL, NULL_TREE, NULL_TREE), gnu_return_label_stack); - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (0); } else @@ -2712,38 +2736,39 @@ tree_transform (Node_Id gnat_node) for (gnat_param = First_Formal (gnat_subprog_id); Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param)) - if (present_gnu_tree (gnat_param)) - adjust_decl_rtl (get_gnu_tree (gnat_param)); - else + if (!present_gnu_tree (gnat_param)) { /* Skip any entries that have been already filled in; they must correspond to IN OUT parameters. */ - for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0; - gnu_cico_list = TREE_CHAIN (gnu_cico_list)) - ; - - /* Do any needed references for padded types. */ - TREE_VALUE (gnu_cico_list) - = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)), - gnat_to_gnu_entity (gnat_param, NULL_TREE, 1)); - } + for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0; + gnu_cico_list = TREE_CHAIN (gnu_cico_list)) + ; + + /* Do any needed references for padded types. */ + TREE_VALUE (gnu_cico_list) + = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)), + gnat_to_gnu_entity (gnat_param, NULL_TREE, 1)); + } + gnat_expand_stmt (end_block_stmt()); + start_block_stmt (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); /* Generate the code of the subprogram itself. A return statement will be present and any OUT parameters will be handled there. */ gnat_to_code (Handled_Statement_Sequence (gnat_node)); - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); gnu_block_stack = TREE_CHAIN (gnu_block_stack); if (TREE_VALUE (gnu_return_label_stack) != 0) { tree gnu_retval; - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); expand_label (TREE_VALUE (gnu_return_label_stack)); gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type); @@ -3270,8 +3295,10 @@ tree_transform (Node_Id gnat_node) case N_Package_Specification: + start_block_stmt (); process_decls (Visible_Declarations (gnat_node), Private_Declarations (gnat_node), Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); break; case N_Package_Body: @@ -3280,7 +3307,9 @@ tree_transform (Node_Id gnat_node) if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package) break; + start_block_stmt (); process_decls (Declarations (gnat_node), Empty, Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); if (Present (Handled_Statement_Sequence (gnat_node))) { @@ -3334,8 +3363,10 @@ tree_transform (Node_Id gnat_node) break; }; + start_block_stmt(); process_decls (Declarations (Aux_Decls_Node (gnat_node)), Empty, Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); gnat_to_code (Unit (gnat_node)); @@ -3440,7 +3471,7 @@ tree_transform (Node_Id gnat_node) /* Make a binding level that we can exit if we need one. */ if (exitable_binding_for_block) { - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (1); } @@ -3457,6 +3488,9 @@ tree_transform (Node_Id gnat_node) integer_type_node, NULL_TREE, 0, 0, 0, 0, 0); + start_block_stmt (); + add_decl_stmt (gnu_cleanup_decl, gnat_node); + gnat_expand_stmt (end_block_stmt ()); expand_decl_cleanup (gnu_cleanup_decl, gnu_cleanup_call); } @@ -3487,6 +3521,11 @@ tree_transform (Node_Id gnat_node) NULL_TREE, 0, 0, 0, 0, 0); + start_block_stmt (); + add_decl_stmt (gnu_jmpsave_decl, gnat_node); + add_decl_stmt (gnu_jmpbuf_decl, gnat_node); + gnat_expand_stmt (end_block_stmt ()); + TREE_VALUE (gnu_block_stack) = gnu_jmpbuf_decl; /* When we exit this block, restore the saved value. */ @@ -3509,7 +3548,7 @@ tree_transform (Node_Id gnat_node) /* Make a binding level for the exception handling declarations and code. Don't assign it an exit label, since this is the outer block we want to exit at the end of each handler. */ - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (0); gnu_except_ptr_stack @@ -3520,6 +3559,9 @@ tree_transform (Node_Id gnat_node) build_call_0_expr (get_excptr_decl), 0, 0, 0, 0, 0), gnu_except_ptr_stack); + start_block_stmt (); + add_decl_stmt (TREE_VALUE (gnu_except_ptr_stack), gnat_node); + gnat_expand_stmt (end_block_stmt ()); /* Generate code for each handler. The N_Exception_Handler case below does the real work. We ignore the dummy exception handler @@ -3540,8 +3582,8 @@ tree_transform (Node_Id gnat_node) gnu_except_ptr_stack = TREE_CHAIN (gnu_except_ptr_stack); /* End the binding level dedicated to the exception handlers. */ - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); /* End the "if" on setjmp. Note that we have arranged things so control never returns here. */ @@ -3566,9 +3608,11 @@ tree_transform (Node_Id gnat_node) /* Generate code and declarations for the prefix of this block, if any. */ + start_block_stmt (); if (Present (First_Real_Statement (gnat_node))) process_decls (Statements (gnat_node), Empty, First_Real_Statement (gnat_node), 1, 1); + gnat_expand_stmt (end_block_stmt ()); /* Generate code for each statement in the block. */ for (gnat_temp = (Present (First_Real_Statement (gnat_node)) @@ -3603,8 +3647,8 @@ tree_transform (Node_Id gnat_node) /* Close the binding level we made, if any. */ if (exitable_binding_for_block) { - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); } } @@ -3766,7 +3810,7 @@ tree_transform (Node_Id gnat_node) expand_start_catch (gnu_etypes_list); - pushlevel (0); + gnat_pushlevel (); expand_start_bindings (0); { @@ -3797,6 +3841,9 @@ tree_transform (Node_Id gnat_node) ptr_type_node, gnu_current_exc_ptr, 0, 0, 0, 0, 0); + start_block_stmt (); + add_decl_stmt (gnu_incoming_exc_ptr, gnat_node); + gnat_expand_stmt (end_block_stmt ()); expand_expr_stmt (build_call_1_expr (begin_handler_decl, gnu_incoming_exc_ptr)); expand_decl_cleanup @@ -3811,9 +3858,8 @@ tree_transform (Node_Id gnat_node) if (Exception_Mechanism == GCC_ZCX) { /* Tell the back end that we're done with the current handler. */ - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); - + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); expand_end_catch (); } else @@ -3927,7 +3973,9 @@ tree_transform (Node_Id gnat_node) case N_Freeze_Entity: process_freeze_entity (gnat_node); + start_block_stmt (); process_decls (Actions (gnat_node), Empty, Empty, 1, 1); + gnat_expand_stmt (end_block_stmt ()); break; case N_Itype_Reference: @@ -4196,6 +4244,136 @@ first_nondeleted_insn (rtx insns) return insns; } +/* Push the BLOCK_STMT stack and allocate a new BLOCK_STMT. */ + +static tree +start_block_stmt () +{ + tree gnu_block_stmt; + + /* First see if we can get one from the free list. */ + if (gnu_block_stmt_free_list) + { + gnu_block_stmt = gnu_block_stmt_free_list; + gnu_block_stmt_free_list = TREE_CHAIN (gnu_block_stmt_free_list); + } + else + { + gnu_block_stmt = make_node (BLOCK_STMT); + TREE_TYPE (gnu_block_stmt) = void_type_node; + } + + BLOCK_STMT_LIST (gnu_block_stmt) = 0; + TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_node; + gnu_block_stmt_node = gnu_block_stmt; + + return gnu_block_stmt; +} + +/* Add GNU_STMT to the current BLOCK_STMT node. We add them backwards + order and the reverse in end_block_stmt. */ + +void +add_stmt (tree gnu_stmt) +{ + if (TREE_CODE_CLASS (TREE_CODE (gnu_stmt)) != 's') + gigi_abort (340); + + if (TREE_CODE (gnu_stmt) != NULL_STMT) + { + TREE_CHAIN (gnu_stmt) = BLOCK_STMT_LIST (gnu_block_stmt_node); + BLOCK_STMT_LIST (gnu_block_stmt_node) = gnu_stmt; + } + + /* If this is a DECL_STMT for a variable with DECL_INIT_BY_ASSIGN_P set, + generate the assignment statement too. */ + if (TREE_CODE (gnu_stmt) == DECL_STMT + && TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == VAR_DECL + && DECL_INIT_BY_ASSIGN_P (DECL_STMT_VAR (gnu_stmt))) + { + tree gnu_decl = DECL_STMT_VAR (gnu_stmt); + tree gnu_lhs = gnu_decl; + tree gnu_assign_stmt; + + /* If decl has a padded type, convert it to the unpadded type so the + assignment is done properly. */ + if (TREE_CODE (TREE_TYPE (gnu_lhs)) == RECORD_TYPE + && TYPE_IS_PADDING_P (TREE_TYPE (gnu_lhs))) + gnu_lhs + = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_lhs))), gnu_lhs); + + gnu_assign_stmt + = build_nt (EXPR_STMT, + build_binary_op (MODIFY_EXPR, NULL_TREE, + gnu_lhs, DECL_INITIAL (gnu_decl))); + DECL_INITIAL (gnu_decl) = 0; + DECL_INIT_BY_ASSIGN_P (gnu_decl) = 0; + + TREE_SLOC (gnu_assign_stmt) = TREE_SLOC (gnu_stmt); + TREE_TYPE (gnu_assign_stmt) = void_type_node; + add_stmt (gnu_assign_stmt); + } +} + +/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node. + Get SLOC from Entity_Id. */ + +void +add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity) +{ + tree gnu_stmt; + + /* If this is a variable that Gigi is to ignore, we may have been given + an ERROR_MARK. So test for it. We also might have been given a + reference for a renaming. So only do something for a decl. */ + if (!DECL_P (gnu_decl)) + return; + + gnu_stmt = build_nt (DECL_STMT, gnu_decl); + TREE_TYPE (gnu_stmt) = void_type_node; + TREE_SLOC (gnu_stmt) = Sloc (gnat_entity); + add_stmt (gnu_stmt); +} + +/* Return the BLOCK_STMT that corresponds to the statement that add_stmt + has been emitting or just a single statement if only one. */ + +static tree +end_block_stmt () +{ + tree gnu_block_stmt = gnu_block_stmt_node; + tree gnu_retval = gnu_block_stmt; + + gnu_block_stmt_node = TREE_CHAIN (gnu_block_stmt); + TREE_CHAIN (gnu_block_stmt) = 0; + + /* If we have only one statement, return it and free this node. Otherwise, + finish setting up this node and return it. If we have no statements, + return a NULL_STMT. */ + if (BLOCK_STMT_LIST (gnu_block_stmt) == 0) + { + gnu_retval = build_nt (NULL_STMT); + TREE_TYPE (gnu_retval) = void_type_node; + } + else if (TREE_CHAIN (BLOCK_STMT_LIST (gnu_block_stmt)) == 0) + gnu_retval = BLOCK_STMT_LIST (gnu_block_stmt); + else + { + BLOCK_STMT_LIST (gnu_block_stmt) + = nreverse (BLOCK_STMT_LIST (gnu_block_stmt)); + TREE_SLOC (gnu_block_stmt) + = TREE_SLOC (BLOCK_STMT_LIST (gnu_block_stmt)); + } + + if (gnu_retval != gnu_block_stmt) + { + TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_free_list; + gnu_block_stmt_free_list = gnu_block_stmt; + } + + return gnu_retval; +} + /* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements. */ static tree @@ -4207,15 +4385,15 @@ build_block_stmt (List_Id gnat_list) if (No (gnat_list) || Is_Empty_List (gnat_list)) return NULL_TREE; + start_block_stmt (); + for (gnat_node = First (gnat_list); Present (gnat_node); gnat_node = Next (gnat_node)) - gnu_result = chainon (gnat_to_gnu (gnat_node), gnu_result); + add_stmt (gnat_to_gnu (gnat_node)); - gnu_result = build_nt (BLOCK_STMT, nreverse (gnu_result)); - TREE_SLOC (gnu_result) = TREE_SLOC (BLOCK_STMT_LIST (gnu_result)); - TREE_TYPE (gnu_result) = void_type_node; - return gnu_result; + gnu_result = end_block_stmt (); + return TREE_CODE (gnu_result) == NULL_STMT ? NULL_TREE : gnu_result; } /* Build an EXPR_STMT to evaluate INSNS. Use Sloc from GNAT_NODE. */ @@ -4253,17 +4431,37 @@ gnat_expand_stmt (tree gnu_stmt) expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt)); break; + case NULL_STMT: + break; + + case DECL_STMT: + if (TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == TYPE_DECL) + force_type_save_exprs (TREE_TYPE (DECL_STMT_VAR (gnu_stmt))); + else + { + expand_decl (DECL_STMT_VAR (gnu_stmt)); + if (DECL_CONTEXT (DECL_STMT_VAR (gnu_stmt))) + expand_decl_init (DECL_STMT_VAR (gnu_stmt)); + + if (TREE_ADDRESSABLE (DECL_STMT_VAR (gnu_stmt))) + { + put_var_into_stack (DECL_STMT_VAR (gnu_stmt), true); + flush_addressof (DECL_STMT_VAR (gnu_stmt)); + } + } + break; + case BLOCK_STMT: for (gnu_elmt = BLOCK_STMT_LIST (gnu_stmt); gnu_elmt; gnu_elmt = TREE_CHAIN (gnu_elmt)) - expand_expr_stmt (gnu_elmt); + gnat_expand_stmt (gnu_elmt); break; case IF_STMT: expand_start_cond (IF_STMT_COND (gnu_stmt), 0); if (IF_STMT_TRUE (gnu_stmt)) - expand_expr_stmt (IF_STMT_TRUE (gnu_stmt)); + gnat_expand_stmt (IF_STMT_TRUE (gnu_stmt)); for (gnu_elmt = IF_STMT_ELSEIF (gnu_stmt); gnu_elmt; gnu_elmt = TREE_CHAIN (gnu_elmt)) @@ -4271,13 +4469,14 @@ gnat_expand_stmt (tree gnu_stmt) expand_start_else (); set_lineno_from_sloc (TREE_SLOC (gnu_elmt), 1); expand_elseif (IF_STMT_COND (gnu_elmt)); - expand_expr_stmt (IF_STMT_TRUE (gnu_elmt)); + if (IF_STMT_TRUE (gnu_elmt)) + gnat_expand_stmt (IF_STMT_TRUE (gnu_elmt)); } if (IF_STMT_ELSE (gnu_stmt)) { expand_start_else (); - expand_expr_stmt (IF_STMT_ELSE (gnu_stmt)); + gnat_expand_stmt (IF_STMT_ELSE (gnu_stmt)); } expand_end_cond (); @@ -4324,8 +4523,8 @@ gnat_expand_stmt (tree gnu_stmt) } break; - default: - abort (); + default: + abort (); } } @@ -4570,11 +4769,8 @@ process_inlined_subprograms (Node_Id gnat_node) correspond to the public and private parts of a package. */ static void -process_decls (List_Id gnat_decls, - List_Id gnat_decls2, - Node_Id gnat_end_list, - int pass1p, - int pass2p) +process_decls (List_Id gnat_decls, List_Id gnat_decls2, + Node_Id gnat_end_list, int pass1p, int pass2p) { List_Id gnat_decl_array[2]; Node_Id gnat_decl; @@ -4603,7 +4799,9 @@ process_decls (List_Id gnat_decls, freeze node. */ else if (Nkind (gnat_decl) == N_Freeze_Entity) { + start_block_stmt (); process_freeze_entity (gnat_decl); + gnat_expand_stmt (end_block_stmt ()); process_decls (Actions (gnat_decl), Empty, Empty, 1, 0); } @@ -4643,7 +4841,7 @@ process_decls (List_Id gnat_decls, Node_Id gnat_subprog_id = Defining_Entity (Specification (gnat_decl)); - if (Ekind (gnat_subprog_id) != E_Subprogram_Body + if (Ekind (gnat_subprog_id) != E_Subprogram_Body && Ekind (gnat_subprog_id) != E_Generic_Procedure && Ekind (gnat_subprog_id) != E_Generic_Function) gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, 1); @@ -4656,7 +4854,11 @@ process_decls (List_Id gnat_decls, ; else - gnat_to_code (gnat_decl); + { + start_block_stmt (); + gnat_to_code (gnat_decl); + gnat_expand_stmt (end_block_stmt ()); + } } /* Here we elaborate everything we deferred above except for package bodies, @@ -5082,6 +5284,7 @@ process_type (Entity_Id gnat_entity) } /* Now fully elaborate the type. */ + start_block_stmt (); gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 1); if (TREE_CODE (gnu_new) != TYPE_DECL) gigi_abort (324); @@ -5112,6 +5315,8 @@ process_type (Entity_Id gnat_entity) update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_task_old)), TREE_TYPE (gnu_new)); } + + gnat_expand_stmt (end_block_stmt ()); } /* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate. @@ -5499,7 +5704,7 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) begin_subprog_body (gnu_decl); set_lineno (gnat_unit, 1); - pushlevel (0); + gnat_pushlevel (); gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack); expand_start_bindings (0); @@ -5542,8 +5747,8 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list) break; } - expand_end_bindings (NULL_TREE, kept_level_p (), -1); - poplevel (kept_level_p (), 1, 0); + expand_end_bindings (NULL_TREE, block_has_vars (), -1); + gnat_poplevel (); gnu_block_stack = TREE_CHAIN (gnu_block_stack); end_subprog_body (); @@ -5599,7 +5804,7 @@ set_lineno_from_sloc (Source_Ptr source_location, int write_note_p) (Debug_Source_Name (Get_Source_File_Index (source_location)))));; input_line = Get_Logical_Line_Number (source_location); - if (write_note_p) + if (! global_bindings_p () && write_note_p) emit_line_note (input_location); } diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 6022dbfe758..ead346f2775 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -84,7 +84,7 @@ static GTY(()) tree pending_elaborations; /* This stack allows us to momentarily switch to generating elaboration lists for an inner context. */ -struct e_stack GTY(()) { +struct e_stack GTY((chain_next ("%h.next"))) { struct e_stack *next; tree elab_list; }; @@ -110,36 +110,22 @@ static GTY(()) tree float_types[NUM_MACHINE_MODES]; Binding contours are used to create GCC tree BLOCK nodes. */ -struct binding_level GTY(()) +struct ada_binding_level GTY((chain_next ("%h.chain"))) { - /* A chain of ..._DECL nodes for all variables, constants, functions, - parameters and type declarations. These ..._DECL nodes are chained - through the TREE_CHAIN field. Note that these ..._DECL nodes are stored - in the reverse of the order supplied to be compatible with the - back-end. */ - tree names; - /* For each level (except the global one), a chain of BLOCK nodes for all - the levels that were entered and exited one level down from this one. */ - tree blocks; - /* The BLOCK node for this level, if one has been preallocated. - If 0, the BLOCK is allocated (if needed) when the level is popped. */ - tree this_block; /* The binding level containing this one (the enclosing binding level). */ - struct binding_level *level_chain; + struct ada_binding_level *chain; + /* The BLOCK node for this level. */ + tree block; }; /* The binding level currently in effect. */ -static GTY(()) struct binding_level *current_binding_level; +static GTY(()) struct ada_binding_level *current_binding_level; -/* A chain of binding_level structures awaiting reuse. */ -static GTY((deletable (""))) struct binding_level *free_binding_level; +/* A chain of ada_binding_level structures awaiting reuse. */ +static GTY((deletable)) struct ada_binding_level *free_binding_level; -/* The outermost binding level. This binding level is created when the - compiler is started and it will exist through the entire compilation. */ -static struct binding_level *global_binding_level; - -/* Binding level structures are initialized by copying this one. */ -static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL}; +/* A chain of unused BLOCK nodes. */ +static GTY((deletable)) tree free_block_chain; struct language_function GTY(()) { @@ -219,8 +205,7 @@ present_gnu_tree (Entity_Id gnat_entity) int global_bindings_p (void) { - return (force_global != 0 || current_binding_level == global_binding_level - ? -1 : 0); + return (force_global != 0 || current_binding_level->chain == 0 ? -1 : 0); } /* Return the list of declarations in the current level. Note that this list @@ -229,163 +214,102 @@ global_bindings_p (void) tree getdecls (void) { - return current_binding_level->names; -} - -/* Nonzero if the current level needs to have a BLOCK made. */ - -int -kept_level_p (void) -{ - return (current_binding_level->names != 0); + return BLOCK_VARS (current_binding_level->block); } -/* Enter a new binding level. The input parameter is ignored, but has to be - specified for back-end compatibility. */ +/* Enter a new binding level. */ void -pushlevel (int ignore ATTRIBUTE_UNUSED) +gnat_pushlevel () { - struct binding_level *newlevel = NULL; + struct ada_binding_level *newlevel = NULL; /* Reuse a struct for this binding level, if there is one. */ if (free_binding_level) { newlevel = free_binding_level; - free_binding_level = free_binding_level->level_chain; + free_binding_level = free_binding_level->chain; } else newlevel - = (struct binding_level *) ggc_alloc (sizeof (struct binding_level)); + = (struct ada_binding_level *) + ggc_alloc (sizeof (struct ada_binding_level)); - *newlevel = clear_binding_level; + /* Use a free BLOCK, if any; otherwise, allocate one. */ + if (free_block_chain) + { + newlevel->block = free_block_chain; + free_block_chain = TREE_CHAIN (free_block_chain); + TREE_CHAIN (newlevel->block) = NULL_TREE; + } + else + newlevel->block = make_node (BLOCK); + + /* Point the BLOCK we just made to its parent. */ + if (current_binding_level) + BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block; + + BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE; /* Add this level to the front of the chain (stack) of levels that are active. */ - newlevel->level_chain = current_binding_level; + newlevel->chain = current_binding_level; current_binding_level = newlevel; } -/* Exit a binding level. - Pop the level off, and restore the state of the identifier-decl mappings - that were in effect when this level was entered. - - If KEEP is nonzero, this level had explicit declarations, so - and create a "block" (a BLOCK node) for the level - to record its declarations and subblocks for symbol table output. +/* Exit a binding level. */ - If FUNCTIONBODY is nonzero, this level is the body of a function, - so create a block as if KEEP were set and also clear out all - label names. - - If REVERSE is nonzero, reverse the order of decls before putting - them into the BLOCK. */ - -tree -poplevel (int keep, int reverse, int functionbody) +void +gnat_poplevel () { - /* Points to a GCC BLOCK tree node. This is the BLOCK node construted for the - binding level that we are about to exit and which is returned by this - routine. */ - tree block = NULL_TREE; - tree decl_chain; - tree decl_node; - tree subblock_chain = current_binding_level->blocks; - tree subblock_node; - int block_previously_created; - - /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL - nodes chained through the `names' field of current_binding_level are in - reverse order except for PARM_DECL node, which are explicitly stored in - the right order. */ - current_binding_level->names - = decl_chain = (reverse) ? nreverse (current_binding_level->names) - : current_binding_level->names; + struct ada_binding_level *level = current_binding_level; + tree block = level->block; + tree decl; + + BLOCK_VARS (block) = nreverse (BLOCK_VARS (block)); + BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block)); /* Output any nested inline functions within this block which must be compiled because their address is needed. */ - for (decl_node = decl_chain; decl_node; decl_node = TREE_CHAIN (decl_node)) - if (TREE_CODE (decl_node) == FUNCTION_DECL - && ! TREE_ASM_WRITTEN (decl_node) && TREE_ADDRESSABLE (decl_node) - && DECL_INITIAL (decl_node) != 0) + for (decl = BLOCK_VARS (block); decl; decl = TREE_CHAIN (decl)) + if (TREE_CODE (decl) == FUNCTION_DECL + && ! TREE_ASM_WRITTEN (decl) && TREE_ADDRESSABLE (decl) + && DECL_INITIAL (decl) != 0) { push_function_context (); /* ??? This is temporary. */ ggc_push_context (); - output_inline_function (decl_node); + output_inline_function (decl); ggc_pop_context (); pop_function_context (); } - block = 0; - block_previously_created = (current_binding_level->this_block != 0); - if (block_previously_created) - block = current_binding_level->this_block; - else if (keep || functionbody) - block = make_node (BLOCK); - if (block != 0) - { - BLOCK_VARS (block) = keep ? decl_chain : 0; - BLOCK_SUBBLOCKS (block) = subblock_chain; - } - - /* Record the BLOCK node just built as the subblock its enclosing scope. */ - for (subblock_node = subblock_chain; subblock_node; - subblock_node = TREE_CHAIN (subblock_node)) - BLOCK_SUPERCONTEXT (subblock_node) = block; - - /* Clear out the meanings of the local variables of this level. */ - - for (subblock_node = decl_chain; subblock_node; - subblock_node = TREE_CHAIN (subblock_node)) - if (DECL_NAME (subblock_node) != 0) - /* If the identifier was used or addressed via a local extern decl, - don't forget that fact. */ - if (DECL_EXTERNAL (subblock_node)) - { - if (TREE_USED (subblock_node)) - TREE_USED (DECL_NAME (subblock_node)) = 1; - if (TREE_ADDRESSABLE (subblock_node)) - TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1; - } - - { - /* Pop the current level, and free the structure for reuse. */ - struct binding_level *level = current_binding_level; - current_binding_level = current_binding_level->level_chain; - level->level_chain = free_binding_level; - free_binding_level = level; - } - - if (functionbody) + /* If this is a function-level BLOCK don't do anything. Otherwise, if there + are no variables free the block and merge its subblocks into those of its + parent block. Otherwise, add it to the list of its parent. */ + if (TREE_CODE (BLOCK_SUPERCONTEXT (block)) == FUNCTION_DECL) + ; + else if (BLOCK_VARS (block) == 0) { - /* This is the top level block of a function. The ..._DECL chain stored - in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't - leave them in the BLOCK because they are found in the FUNCTION_DECL - instead. */ - DECL_INITIAL (current_function_decl) = block; - BLOCK_VARS (block) = 0; + BLOCK_SUBBLOCKS (level->chain->block) + = chainon (BLOCK_SUBBLOCKS (block), + BLOCK_SUBBLOCKS (level->chain->block)); + TREE_CHAIN (block) = free_block_chain; + free_block_chain = block; } - else if (block) + else { - if (!block_previously_created) - current_binding_level->blocks - = chainon (current_binding_level->blocks, block); + TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block); + BLOCK_SUBBLOCKS (level->chain->block) = block; + TREE_USED (block) = 1; } - /* If we did not make a block for the level just exited, any blocks made for - inner levels (since they cannot be recorded as subblocks in that level) - must be carried forward so they will later become subblocks of something - else. */ - else if (subblock_chain) - current_binding_level->blocks - = chainon (current_binding_level->blocks, subblock_chain); - if (block) - TREE_USED (block) = 1; - - return block; + /* Free this binding structure. */ + current_binding_level = level->chain; + level->chain = free_binding_level; + free_binding_level = level; } - + /* Insert BLOCK at the end of the list of subblocks of the current binding level. This is used when a BIND_EXPR is expanded, to handle the BLOCK node inside the BIND_EXPR. */ @@ -394,55 +318,42 @@ void insert_block (tree block) { TREE_USED (block) = 1; - current_binding_level->blocks - = chainon (current_binding_level->blocks, block); + TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block); + BLOCK_SUBBLOCKS (current_binding_level->block) = block; } -/* Set the BLOCK node for the innermost scope - (the one we are currently in). */ +/* Return nonzero if the current binding has any variables. This means + it will have a BLOCK node. */ -void -set_block (tree block) +int +block_has_vars () { - current_binding_level->this_block = block; - current_binding_level->names = chainon (current_binding_level->names, - BLOCK_VARS (block)); - current_binding_level->blocks = chainon (current_binding_level->blocks, - BLOCK_SUBBLOCKS (block)); + return BLOCK_VARS (current_binding_level->block) != 0; } - + /* Records a ..._DECL node DECL as belonging to the current lexical scope. Returns the ..._DECL node. */ tree pushdecl (tree decl) { - struct binding_level *b; - /* If at top level, there is no context. But PARM_DECLs always go in the level of its function. */ if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL) - { - b = global_binding_level; - DECL_CONTEXT (decl) = 0; - } + DECL_CONTEXT (decl) = 0; else - { - b = current_binding_level; - DECL_CONTEXT (decl) = current_function_decl; - } + DECL_CONTEXT (decl) = current_function_decl; /* Put the declaration on the list. The list of declarations is in reverse - order. The list will be reversed later if necessary. This needs to be - this way for compatibility with the back-end. + order. The list will be reversed later. Don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into the list. They will cause trouble with the debugger and aren't needed anyway. */ if (TREE_CODE (decl) != TYPE_DECL || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE) { - TREE_CHAIN (decl) = b->names; - b->names = decl; + TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block); + BLOCK_VARS (current_binding_level->block) = decl; } /* For the declaration of a type, set its name if it either is not already @@ -478,8 +389,7 @@ gnat_init_decl_processing (void) current_function_decl = 0; current_binding_level = 0; free_binding_level = 0; - pushlevel (0); - global_binding_level = current_binding_level; + gnat_pushlevel (); build_common_tree_nodes (0); @@ -1294,15 +1204,9 @@ create_type_decl (tree type_name, it indicates whether to always allocate storage to the variable. */ tree -create_var_decl (tree var_name, - tree asm_name, - tree type, - tree var_init, - int const_flag, - int public_flag, - int extern_flag, - int static_flag, - struct attrib *attr_list) +create_var_decl (tree var_name, tree asm_name, tree type, tree var_init, + int const_flag, int public_flag, int extern_flag, + int static_flag, struct attrib *attr_list) { int init_const = (var_init == 0 @@ -1321,7 +1225,6 @@ create_var_decl (tree var_name, && 0 >= compare_tree_int (TYPE_SIZE_UNIT (type), GET_MODE_SIZE (DCmode))) ? CONST_DECL : VAR_DECL, var_name, type); - tree assign_init = 0; /* If this is external, throw away any initializations unless this is a CONST_DECL (meaning we have a constant); they will be done elsewhere. If @@ -1346,7 +1249,7 @@ create_var_decl (tree var_name, && ((TYPE_MAIN_VARIANT (TREE_TYPE (var_init)) != TYPE_MAIN_VARIANT (type)) || (static_flag && ! init_const))) - assign_init = var_init, var_init = 0; + DECL_INIT_BY_ASSIGN_P (var_decl) = 1; DECL_INITIAL (var_decl) = var_init; TREE_READONLY (var_decl) = const_flag; @@ -1369,32 +1272,13 @@ create_var_decl (tree var_name, /* Add this decl to the current binding level and generate any needed code and RTL. */ var_decl = pushdecl (var_decl); - expand_decl (var_decl); - - if (DECL_CONTEXT (var_decl) != 0) - expand_decl_init (var_decl); - /* If this is volatile, force it into memory. */ if (TREE_SIDE_EFFECTS (var_decl)) - gnat_mark_addressable (var_decl); + TREE_ADDRESSABLE (var_decl) = 1; if (TREE_CODE (var_decl) != CONST_DECL) rest_of_decl_compilation (var_decl, 0, global_bindings_p (), 0); - if (assign_init != 0) - { - /* If VAR_DECL has a padded type, convert it to the unpadded - type so the assignment is done properly. */ - tree lhs = var_decl; - - if (TREE_CODE (TREE_TYPE (lhs)) == RECORD_TYPE - && TYPE_IS_PADDING_P (TREE_TYPE (lhs))) - lhs = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (lhs))), lhs); - - expand_expr_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, lhs, - assign_init)); - } - return var_decl; } @@ -1859,8 +1743,7 @@ begin_subprog_body (tree subprog_decl) announce_function (subprog_decl); /* Make this field nonzero so further routines know that this is not - tentative. error_mark_node is replaced below (in poplevel) with the - adequate BLOCK. */ + tentative. error_mark_node is replaced below with the adequate BLOCK. */ DECL_INITIAL (subprog_decl) = error_mark_node; /* This function exists in static storage. This does not mean `static' in @@ -1870,7 +1753,7 @@ begin_subprog_body (tree subprog_decl) /* Enter a new binding level and show that all the parameters belong to this function. */ current_function_decl = subprog_decl; - pushlevel (0); + gnat_pushlevel (); for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl; param_decl = TREE_CHAIN (param_decl)) @@ -1896,9 +1779,12 @@ end_subprog_body (void) tree decl; tree cico_list; - poplevel (1, 0, 1); - BLOCK_SUPERCONTEXT (DECL_INITIAL (current_function_decl)) - = current_function_decl; + /* Mark the BLOCK for this level as being for this function and pop the + level. Since the vars in it are the parameters, clear them. */ + BLOCK_VARS (current_binding_level->block) = 0; + BLOCK_SUPERCONTEXT (current_binding_level->block) = current_function_decl; + DECL_INITIAL (current_function_decl) = current_binding_level->block; + gnat_poplevel (); /* Mark the RESULT_DECL as being in this subprogram. */ DECL_CONTEXT (DECL_RESULT (current_function_decl)) = current_function_decl; diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c index 5882d094b5d..cafbf7d8fb0 100644 --- a/gcc/ada/utils2.c +++ b/gcc/ada/utils2.c @@ -1990,7 +1990,6 @@ gnat_mark_addressable (tree expr_node) case PARM_DECL: case RESULT_DECL: put_var_into_stack (expr_node, true); - TREE_ADDRESSABLE (expr_node) = 1; return true; case FUNCTION_DECL: |