Skip to content

R
riscv-gcc-1
Commit b5e792e2 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r81935
parent 646ca712
Showing with 871 additions and 676 deletions
gcc/ada/ChangeLog
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
......
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 ???
......
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) :=
......
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;
......
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;
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)
......
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)
......
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;
......
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;
......
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)));
......
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
......
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;
......
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;
......
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. */
......
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
......
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;
......
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 --
------------------------
......
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
......
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,
......
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
......
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;
......
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;
......
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
......
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;
......
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;
......
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
......
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.
......
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;
......
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;
......
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;
......
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;
......
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;
......
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);
......
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.
......
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;
......
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.
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment