From 7f9be3624360758959cac55dff8abec8b13d7e4e Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 17 May 2004 13:20:48 +0000 Subject: 2004-05-17 Richard Kenner 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 * 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 * 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 * 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 --- gcc/ada/s-taprop-lynxos.adb | 84 ++++++++++++++++++++++----------------------- 1 file changed, 42 insertions(+), 42 deletions(-) (limited to 'gcc/ada/s-taprop-lynxos.adb') diff --git a/gcc/ada/s-taprop-lynxos.adb b/gcc/ada/s-taprop-lynxos.adb index 6276d7f5092..42f77f75f29 100644 --- a/gcc/ada/s-taprop-lynxos.adb +++ b/gcc/ada/s-taprop-lynxos.adb @@ -66,7 +66,7 @@ with System.Parameters; with System.Tasking; -- used for Ada_Task_Control_Block --- Task_ID +-- Task_Id with System.Soft_Links; -- used for Defer/Undefer_Abort @@ -105,10 +105,10 @@ package body System.Task_Primitives.Operations is -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List ATCB_Key : aliased pthread_key_t; - -- Key used to find the Ada Task_ID associated with a thread + -- Key used to find the Ada Task_Id associated with a thread - Environment_Task_ID : Task_ID; - -- A variable to hold Task_ID for the environment task. + Environment_Task_Id : Task_Id; + -- A variable to hold Task_Id for the environment task. Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); @@ -144,7 +144,7 @@ package body System.Task_Primitives.Operations is package Specific is - procedure Initialize (Environment_Task : Task_ID); + procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); -- Initialize various data needed by this package. @@ -152,11 +152,11 @@ package body System.Task_Primitives.Operations is pragma Inline (Is_Valid_Task); -- Does the current thread have an ATCB? - procedure Set (Self_Id : Task_ID); + procedure Set (Self_Id : Task_Id); pragma Inline (Set); -- Set the self id for the current task. - function Self return Task_ID; + function Self return Task_Id; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. @@ -169,11 +169,11 @@ package body System.Task_Primitives.Operations is -- Support for foreign threads -- --------------------------------- - function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID; + function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; -- Allocate and Initialize a new ATCB for the current Thread. function Register_Foreign_Thread - (Thread : Thread_Id) return Task_ID is separate; + (Thread : Thread_Id) return Task_Id is separate; ----------------------- -- Local Subprograms -- @@ -182,7 +182,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal); -- Signal handler used to implement asynchronous abort. - procedure Set_OS_Priority (T : Task_ID; Prio : System.Any_Priority); + procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority); -- This procedure calls the scheduler of the OS to set thread's priority ------------------- @@ -192,7 +192,7 @@ package body System.Task_Primitives.Operations is procedure Abort_Handler (Sig : Signal) is pragma Unreferenced (Sig); - T : constant Task_ID := Self; + T : constant Task_Id := Self; Result : Interfaces.C.int; Old_Set : aliased sigset_t; @@ -226,7 +226,7 @@ package body System.Task_Primitives.Operations is -- Stack_Guard -- ----------------- - procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is + procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is Stack_Base : constant Address := Get_Stack_Base (T.Common.LL.Thread); Guard_Page_Address : Address; @@ -254,7 +254,7 @@ package body System.Task_Primitives.Operations is -- Get_Thread_Id -- -------------------- - function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is + function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is begin return T.Common.LL.Thread; end Get_Thread_Id; @@ -263,7 +263,7 @@ package body System.Task_Primitives.Operations is -- Self -- ---------- - function Self return Task_ID renames Specific.Self; + function Self return Task_Id renames Specific.Self; --------------------- -- Initialize_Lock -- @@ -349,7 +349,7 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is Result : Interfaces.C.int; - T : constant Task_ID := Self; + T : constant Task_Id := Self; begin if Locking_Policy = 'C' then @@ -386,7 +386,7 @@ package body System.Task_Primitives.Operations is end if; end Write_Lock; - procedure Write_Lock (T : Task_ID) is + procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -410,7 +410,7 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access Lock) is Result : Interfaces.C.int; - T : constant Task_ID := Self; + T : constant Task_Id := Self; begin Result := pthread_mutex_unlock (L.Mutex'Access); @@ -432,7 +432,7 @@ package body System.Task_Primitives.Operations is end if; end Unlock; - procedure Unlock (T : Task_ID) is + procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; begin if not Single_Lock then @@ -446,7 +446,7 @@ package body System.Task_Primitives.Operations is ----------- procedure Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); @@ -475,7 +475,7 @@ package body System.Task_Primitives.Operations is -- holding its own ATCB lock. procedure Timed_Sleep - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes; Reason : Task_States; @@ -554,7 +554,7 @@ package body System.Task_Primitives.Operations is -- the caller is abort-deferred but is holding no locks. procedure Timed_Delay - (Self_ID : Task_ID; + (Self_ID : Task_Id; Time : Duration; Mode : ST.Delay_Modes) is @@ -672,7 +672,7 @@ package body System.Task_Primitives.Operations is -- Wakeup -- ------------ - procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is + procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is pragma Unreferenced (Reason); Result : Interfaces.C.int; begin @@ -697,7 +697,7 @@ package body System.Task_Primitives.Operations is -- Set_Priority -- ------------------ - procedure Set_OS_Priority (T : Task_ID; Prio : System.Any_Priority) is + procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority) is Result : Interfaces.C.int; Param : aliased struct_sched_param; @@ -726,7 +726,7 @@ package body System.Task_Primitives.Operations is -- Comments needed for these declarations ??? procedure Set_Priority - (T : Task_ID; + (T : Task_Id; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False) is @@ -764,7 +764,7 @@ package body System.Task_Primitives.Operations is -- Get_Priority -- ------------------ - function Get_Priority (T : Task_ID) return System.Any_Priority is + function Get_Priority (T : Task_Id) return System.Any_Priority is begin return T.Common.Current_Priority; end Get_Priority; @@ -773,7 +773,7 @@ package body System.Task_Primitives.Operations is -- Enter_Task -- ---------------- - procedure Enter_Task (Self_ID : Task_ID) is + procedure Enter_Task (Self_ID : Task_Id) is begin Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.LWP := lwp_self; @@ -797,7 +797,7 @@ package body System.Task_Primitives.Operations is -- New_ATCB -- -------------- - function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is + function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is begin return new Ada_Task_Control_Block (Entry_Num); end New_ATCB; @@ -812,7 +812,7 @@ package body System.Task_Primitives.Operations is -- Register_Foreign_Thread -- ----------------------------- - function Register_Foreign_Thread return Task_ID is + function Register_Foreign_Thread return Task_Id is begin if Is_Valid_Task then return Self; @@ -825,7 +825,7 @@ package body System.Task_Primitives.Operations is -- Initialize_TCB -- ---------------------- - procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is + procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is Mutex_Attr : aliased pthread_mutexattr_t; Result : Interfaces.C.int; Cond_Attr : aliased pthread_condattr_t; @@ -885,7 +885,7 @@ package body System.Task_Primitives.Operations is ----------------- procedure Create_Task - (T : Task_ID; + (T : Task_Id; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; @@ -970,13 +970,13 @@ package body System.Task_Primitives.Operations is -- Finalize_TCB -- ------------------ - procedure Finalize_TCB (T : Task_ID) is + procedure Finalize_TCB (T : Task_Id) is Result : Interfaces.C.int; - Tmp : Task_ID := T; + Tmp : Task_Id := T; Is_Self : constant Boolean := T = Self; procedure Free is new - Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); + Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id); begin if not Single_Lock then @@ -1013,7 +1013,7 @@ package body System.Task_Primitives.Operations is -- Abort_Task -- ---------------- - procedure Abort_Task (T : Task_ID) is + procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; begin Result := pthread_kill (T.Common.LL.Thread, @@ -1027,7 +1027,7 @@ package body System.Task_Primitives.Operations is -- Dummy versions - function Check_Exit (Self_ID : ST.Task_ID) return Boolean is + function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -1037,7 +1037,7 @@ package body System.Task_Primitives.Operations is -- Check_No_Locks -- -------------------- - function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is + function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); begin return True; @@ -1047,9 +1047,9 @@ package body System.Task_Primitives.Operations is -- Environment_Task -- ---------------------- - function Environment_Task return Task_ID is + function Environment_Task return Task_Id is begin - return Environment_Task_ID; + return Environment_Task_Id; end Environment_Task; -------------- @@ -1075,7 +1075,7 @@ package body System.Task_Primitives.Operations is ------------------ function Suspend_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is @@ -1090,7 +1090,7 @@ package body System.Task_Primitives.Operations is ----------------- function Resume_Task - (T : ST.Task_ID; + (T : ST.Task_Id; Thread_Self : Thread_Id) return Boolean is pragma Unreferenced (T); @@ -1103,7 +1103,7 @@ package body System.Task_Primitives.Operations is -- Initialize -- ---------------- - procedure Initialize (Environment_Task : Task_ID) is + procedure Initialize (Environment_Task : Task_Id) is act : aliased struct_sigaction; old_act : aliased struct_sigaction; Tmp_Set : aliased sigset_t; @@ -1125,7 +1125,7 @@ package body System.Task_Primitives.Operations is -- system handler) begin - Environment_Task_ID := Environment_Task; + Environment_Task_Id := Environment_Task; -- Initialize the lock used to synchronize chain of all ATCBs. -- cgit v1.2.1