summaryrefslogtreecommitdiff
path: root/gcc/ada/s-taprop-mingw.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-05-17 13:20:48 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-05-17 13:20:48 +0000
commit7f9be3624360758959cac55dff8abec8b13d7e4e (patch)
tree2b5692e6b47e044d030ae4b10881296d50e2f101 /gcc/ada/s-taprop-mingw.adb
parenta9d86d5dde106b29ae985f1468c23469c793fca0 (diff)
downloadgcc-7f9be3624360758959cac55dff8abec8b13d7e4e.tar.gz
2004-05-17 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
Part of function-at-a-time conversion * misc.c (adjust_decl_rtl): Deleted. (LANG_HOOKS_PUSHLEVEL, LANG_HOOKS_POPLEVEL, LANG_HOOKS_SET_BLOCK): Define. * gigi.h: (adjust_decl_rtl, kept_level_p, set_block): Deleted. (add_decl_stmt, add_stmt, block_has_vars): New functions. (gnat_pushlevel, gnat_poplevel): Renamed from pushlevel and poplevel. * decl.c (elaborate_expression, maybe_pad_type): Call add_decl_stmt when making a decl. (gnat_to_gnu_entity): Likewise. Use add_stmt to update setjmp buffer. Set TREE_ADDRESSABLE instead of calling put_var_into_stack and flush_addressof. No longer call adjust_decl_rtl. (DECL_INIT_BY_ASSIGN_P): New macro. (DECL_STMT_VAR): Likewise. * trans.c (gigi): Call start_block_stmt to make the outermost BLOCK_STMT. (gnat_to_code, gnu_to_gnu, tree_transform, process_decls, process_type): Call start_block_stmt and end_block_stmt temporarily. Use gnat_expand_stmt instead of expand_expr_stmt. (add_decl_stmt): New function. (tree_transform): Call it. (add_stmt): Also emit initializing assignment for DECL_STMT if needed. (end_block_stmt): Set type and NULL_STMT. (gnat_expand_stmt): Make recursize call instead of calling expand_expr_stmt. (gnat_expand_stmt, case DECL_STMT): New case. (set_lineno_from_sloc): Do nothing if global. (gnu_block_stmt_node, gnu_block_stmt_free_list): New variables. (start_block_stmt, add_stmt, end_block_stmt): New functions. (build_block_stmt): Call them. (gnat_to_code): Don't expand NULL_STMT. (build_unit_elab): Rename pushlevel and poplevel to gnat_* and change args. (tree_transform): Likewise. (tree_transform, case N_Null_Statement): Return NULL_STMT. (gnat_expand_stmt, case NULL_STMT): New case. (gnat_expand_stmt, case IF_STMT): Allow nested IF_STMT to have no IF_STMT_TRUE. * utils2.c (gnat_mark_addressable, case VAR_DECL): Do not set TREE_ADDRESSABLE. * utils.c (create_var_decl): Do not call expand_decl or expand_decl_init. Set TREE_ADDRESSABLE instead of calling gnat_mark_addressable. Set DECL_INIT_BY_ASSIGN_P when needed and do not generate MODIFY_EXPR here. (struct e_stack): Add chain_next to GTY. (struct binding_level): Deleted. (struct ada_binding_level): New struct. (free_block_chain): New. (global_binding_level, clear_binding_level): Deleted. (global_bindings_p): Rework to see if no chain. (kept_level_p, set_block): Deleted. (gnat_pushlevel): Renamed from pushlevel and extensive reworked to use new data structure and work directly on BLOCK node. (gnat_poplevel): Similarly. (get_decls): Look at BLOCK_VARS. (insert_block): Work directly on BLOCK node. (block_has_var): New function. (pushdecl): Rework for new binding structures. (gnat_init_decl_processing): Rename and rework calls to pushlevel and poplevel. (build_subprog_body): Likewise. (end_subprog_body): Likewise; also set up BLOCK in DECL_INITIAL. * ada-tree.def (DECL_STMT, NULL_STMT): New codes. * ada-tree.h: (DECL_INIT_BY_ASSIGN_P): New macro. (DECL_STMT_VAR): Likewise. 2004-05-17 Robert Dewar <dewar@gnat.com> * restrict.ads, restrict.adb (Process_Restriction_Synonym): New procedure * sem_prag.adb (Analyze_Pragma, case Restrictions): Cleanup handling of restriction synonyums by using Restrict.Process_Restriction_Synonyms. * snames.ads, snames.adb: Add entries for Process_Restriction_Synonym * s-restri.ads (Tasking_Allowed): Correct missing comment * s-rident.ads: Add entries for restriction synonyms * ali.adb: Fix some problems with badly formatted ALI files that can result in infinite loops. * s-taprop-lynxos.adb, s-tpopsp-lynxos.adb, s-taprop-tru64.adb, s-tpopsp-posix-foreign.adb, s-taprop-irix.adb, s-interr-sigaction.adb, s-taprop-irix-athread.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb, s-taprop-dummy.adb, s-interr-dummy.adb, s-taprop-os2.adb, s-taprop-solaris.adb, s-tpopsp-solaris.adb, s-asthan-vms.adb, s-inmaop-vms.adb, s-interr-vms.adb, s-taprop-vms.adb, s-tpopde-vms.adb, s-taprop-mingw.adb, s-interr-vxworks.adb, s-taprop-vxworks.adb, s-tpopsp-vxworks.adb, s-taprop-posix.adb, s-tpopsp-posix.adb, s-tratas-default.adb, a-dynpri.adb, a-tasatt.adb, a-taside.adb, a-taside.ads, exp_attr.adb, exp_ch9.adb, g-thread.adb, rtsfind.ads, sem_attr.adb, s-interr.adb, s-interr.ads, s-soflin.ads, s-taasde.adb, s-taasde.ads, s-taenca.adb, s-taenca.ads, s-taprop.ads, s-tarest.adb, s-tarest.ads, s-tasdeb.adb, s-tasdeb.ads, s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads, s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads, s-tassta.adb, s-tassta.ads, s-tasuti.adb, s-tasuti.ads, s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads, s-tpoben.adb, s-tpobop.adb, s-tpobop.ads, s-tporft.adb, s-tposen.adb, s-tposen.ads, s-tratas.adb, s-tratas.ads: Change Task_ID to Task_Id (minor cleanup). 2004-05-17 Vincent Celier <celier@gnat.com> * g-os_lib.adb (Normalize_Pathname.Final_Value): Remove trailing directory separator. * prj-proc.adb (Recursive_Process): Inherit attribute Languages from project being extended, if Languages is not declared in extending project. 2004-05-17 Javier Miranda <miranda@gnat.com> * sem_ch10.adb (Install_Limited_Withed_Unit): Do not install the limited view of a visible sibling. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81935 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/s-taprop-mingw.adb')
-rw-r--r--gcc/ada/s-taprop-mingw.adb72
1 files changed, 36 insertions, 36 deletions
diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 1e24de0c6ec..7c9c5922bfe 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -58,7 +58,7 @@ with System.Parameters;
with System.Tasking;
-- used for Ada_Task_Control_Block
--- Task_ID
+-- Task_Id
with System.Soft_Links;
-- used for Defer/Undefer_Abort
@@ -98,8 +98,8 @@ package body System.Task_Primitives.Operations is
-- Local Data --
----------------
- Environment_Task_ID : Task_ID;
- -- A variable to hold Task_ID for the environment task.
+ Environment_Task_Id : Task_Id;
+ -- A variable to hold Task_Id for the environment task.
Single_RTS_Lock : aliased RTS_Lock;
-- This is a lock to allow only one thread of control in the RTS at
@@ -137,7 +137,7 @@ package body System.Task_Primitives.Operations is
pragma Inline (Is_Valid_Task);
-- Does executing thread have a TCB?
- procedure Set (Self_Id : Task_ID);
+ procedure Set (Self_Id : Task_Id);
pragma Inline (Set);
-- Set the self id for the current task.
@@ -150,7 +150,7 @@ package body System.Task_Primitives.Operations is
return TlsGetValue (TlsIndex) /= System.Null_Address;
end Is_Valid_Task;
- procedure Set (Self_Id : Task_ID) is
+ procedure Set (Self_Id : Task_Id) is
Succeeded : BOOL;
begin
Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id));
@@ -163,11 +163,11 @@ package body System.Task_Primitives.Operations is
-- Support for foreign threads --
---------------------------------
- function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID;
+ function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
-- Allocate and Initialize a new ATCB for the current Thread.
function Register_Foreign_Thread
- (Thread : Thread_Id) return Task_ID is separate;
+ (Thread : Thread_Id) return Task_Id is separate;
----------------------------------
-- Condition Variable Functions --
@@ -346,7 +346,7 @@ package body System.Task_Primitives.Operations is
-- bottom of a thread stack, so nothing is needed.
-- ??? Check the comment above
- procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is
+ procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
pragma Warnings (Off, T);
pragma Warnings (Off, On);
@@ -358,7 +358,7 @@ package body System.Task_Primitives.Operations is
-- Get_Thread_Id --
--------------------
- function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is
+ function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
begin
return T.Common.LL.Thread;
end Get_Thread_Id;
@@ -367,8 +367,8 @@ package body System.Task_Primitives.Operations is
-- Self --
----------
- function Self return Task_ID is
- Self_Id : constant Task_ID := To_Task_ID (TlsGetValue (TlsIndex));
+ function Self return Task_Id is
+ Self_Id : constant Task_Id := To_Task_Id (TlsGetValue (TlsIndex));
begin
if Self_Id = null then
return Register_Foreign_Thread (GetCurrentThread);
@@ -447,7 +447,7 @@ package body System.Task_Primitives.Operations is
end if;
end Write_Lock;
- procedure Write_Lock (T : Task_ID) is
+ procedure Write_Lock (T : Task_Id) is
begin
if not Single_Lock then
EnterCriticalSection
@@ -480,7 +480,7 @@ package body System.Task_Primitives.Operations is
end if;
end Unlock;
- procedure Unlock (T : Task_ID) is
+ procedure Unlock (T : Task_Id) is
begin
if not Single_Lock then
LeaveCriticalSection
@@ -493,7 +493,7 @@ package body System.Task_Primitives.Operations is
-----------
procedure Sleep
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Reason : System.Tasking.Task_States)
is
pragma Unreferenced (Reason);
@@ -524,7 +524,7 @@ package body System.Task_Primitives.Operations is
-- holding its own ATCB lock.
procedure Timed_Sleep
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Time : Duration;
Mode : ST.Delay_Modes;
Reason : System.Tasking.Task_States;
@@ -585,7 +585,7 @@ package body System.Task_Primitives.Operations is
-----------------
procedure Timed_Delay
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Time : Duration;
Mode : ST.Delay_Modes)
is
@@ -659,7 +659,7 @@ package body System.Task_Primitives.Operations is
-- Wakeup --
------------
- procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is
+ procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
pragma Unreferenced (Reason);
begin
@@ -692,7 +692,7 @@ package body System.Task_Primitives.Operations is
-- scheduling.
procedure Set_Priority
- (T : Task_ID;
+ (T : Task_Id;
Prio : System.Any_Priority;
Loss_Of_Inheritance : Boolean := False)
is
@@ -740,7 +740,7 @@ package body System.Task_Primitives.Operations is
-- Get_Priority --
------------------
- function Get_Priority (T : Task_ID) return System.Any_Priority is
+ function Get_Priority (T : Task_Id) return System.Any_Priority is
begin
return T.Common.Current_Priority;
end Get_Priority;
@@ -762,7 +762,7 @@ package body System.Task_Primitives.Operations is
-- set in System.Task_Primitives.Operations.Create_Task during the
-- thread creation.
- procedure Enter_Task (Self_ID : Task_ID) is
+ procedure Enter_Task (Self_ID : Task_Id) is
procedure Init_Float;
pragma Import (C, Init_Float, "__gnat_init_float");
-- Properly initializes the FPU for x86 systems.
@@ -790,7 +790,7 @@ package body System.Task_Primitives.Operations is
-- New_ATCB --
--------------
- function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is
+ function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
begin
return new Ada_Task_Control_Block (Entry_Num);
end New_ATCB;
@@ -805,7 +805,7 @@ package body System.Task_Primitives.Operations is
-- Register_Foreign_Thread --
-----------------------------
- function Register_Foreign_Thread return Task_ID is
+ function Register_Foreign_Thread return Task_Id is
begin
if Is_Valid_Task then
return Self;
@@ -818,7 +818,7 @@ package body System.Task_Primitives.Operations is
-- Initialize_TCB --
--------------------
- procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is
+ procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
begin
-- Initialize thread ID to 0, this is needed to detect threads that
-- are not yet activated.
@@ -839,7 +839,7 @@ package body System.Task_Primitives.Operations is
-----------------
procedure Create_Task
- (T : Task_ID;
+ (T : Task_Id;
Wrapper : System.Address;
Stack_Size : System.Parameters.Size_Type;
Priority : System.Any_Priority;
@@ -909,14 +909,14 @@ package body System.Task_Primitives.Operations is
-- Finalize_TCB --
------------------
- procedure Finalize_TCB (T : Task_ID) is
- Self_ID : Task_ID := T;
+ procedure Finalize_TCB (T : Task_Id) is
+ Self_ID : Task_Id := T;
Result : DWORD;
Succeeded : BOOL;
Is_Self : constant Boolean := T = Self;
procedure Free is new
- Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID);
+ Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
begin
if not Single_Lock then
@@ -960,7 +960,7 @@ package body System.Task_Primitives.Operations is
-- Abort_Task --
----------------
- procedure Abort_Task (T : Task_ID) is
+ procedure Abort_Task (T : Task_Id) is
pragma Unreferenced (T);
begin
null;
@@ -970,9 +970,9 @@ package body System.Task_Primitives.Operations is
-- Environment_Task --
----------------------
- function Environment_Task return Task_ID is
+ function Environment_Task return Task_Id is
begin
- return Environment_Task_ID;
+ return Environment_Task_Id;
end Environment_Task;
--------------
@@ -997,12 +997,12 @@ package body System.Task_Primitives.Operations is
-- Initialize --
----------------
- procedure Initialize (Environment_Task : Task_ID) is
+ procedure Initialize (Environment_Task : Task_Id) is
Discard : BOOL;
pragma Unreferenced (Discard);
begin
- Environment_Task_ID := Environment_Task;
+ Environment_Task_Id := Environment_Task;
if Time_Slice_Val = 0 or else FIFO_Within_Priorities then
@@ -1053,7 +1053,7 @@ package body System.Task_Primitives.Operations is
-- Dummy versions. The only currently working versions is for solaris
-- (native).
- function Check_Exit (Self_ID : ST.Task_ID) return Boolean is
+ function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
pragma Unreferenced (Self_ID);
begin
@@ -1064,7 +1064,7 @@ package body System.Task_Primitives.Operations is
-- Check_No_Locks --
--------------------
- function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is
+ function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
pragma Unreferenced (Self_ID);
begin
@@ -1076,7 +1076,7 @@ package body System.Task_Primitives.Operations is
------------------
function Suspend_Task
- (T : ST.Task_ID;
+ (T : ST.Task_Id;
Thread_Self : Thread_Id) return Boolean
is
begin
@@ -1092,7 +1092,7 @@ package body System.Task_Primitives.Operations is
-----------------
function Resume_Task
- (T : ST.Task_ID;
+ (T : ST.Task_Id;
Thread_Self : Thread_Id) return Boolean
is
begin