From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/s-tasren.ads | 329 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 329 insertions(+) create mode 100644 gcc/ada/s-tasren.ads (limited to 'gcc/ada/s-tasren.ads') diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads new file mode 100644 index 000000000..a9a9a2bbb --- /dev/null +++ b/gcc/ada/s-tasren.ads @@ -0,0 +1,329 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . T A S K I N G . R E N D E Z V O U S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2009, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Note: the compiler generates direct calls to this interface, via Rtsfind. +-- Any changes to this interface may require corresponding compiler changes. + +with Ada.Exceptions; + +with System.Tasking.Protected_Objects.Entries; + +package System.Tasking.Rendezvous is + + package STPE renames System.Tasking.Protected_Objects.Entries; + + procedure Task_Entry_Call + (Acceptor : Task_Id; + E : Task_Entry_Index; + Uninterpreted_Data : System.Address; + Mode : Call_Modes; + Rendezvous_Successful : out Boolean); + -- General entry call used to implement ATC or conditional entry calls. + -- Compiler interface only. Do not call from within the RTS. + -- Acceptor is the ID of the acceptor task. + -- E is the entry index requested. + -- Uninterpreted_Data represents the parameters of the entry. It is + -- constructed by the compiler for the caller and the callee; therefore, + -- the run time never needs to decode this data. + -- Mode can be either Asynchronous_Call (ATC) or Conditional_Call. + -- Rendezvous_Successful is set to True on return if the call was serviced. + + procedure Timed_Task_Entry_Call + (Acceptor : Task_Id; + E : Task_Entry_Index; + Uninterpreted_Data : System.Address; + Timeout : Duration; + Mode : Delay_Modes; + Rendezvous_Successful : out Boolean); + -- Timed entry call without using ATC. + -- Compiler interface only. Do not call from within the RTS. + -- See Task_Entry_Call for details on Acceptor, E and Uninterpreted_Data. + -- Timeout is the value of the time out. + -- Mode determines whether the delay is relative or absolute. + + procedure Call_Simple + (Acceptor : Task_Id; + E : Task_Entry_Index; + Uninterpreted_Data : System.Address); + -- Simple entry call. + -- Compiler interface only. Do not call from within the RTS. + -- + -- source: + -- T.E1 (Params); + -- + -- expansion: + -- declare + -- P : parms := (parm1, parm2, parm3); + -- X : Task_Entry_Index := 1; + -- begin + -- Call_Simple (t._task_id, X, P'Address); + -- parm1 := P.param1; + -- parm2 := P.param2; + -- ... + -- end; + + procedure Cancel_Task_Entry_Call (Cancelled : out Boolean); + -- Cancel pending asynchronous task entry call. + -- Compiler interface only. Do not call from within the RTS. + -- See Exp_Ch9.Expand_N_Asynchronous_Select for code expansion. + + procedure Requeue_Task_Entry + (Acceptor : Task_Id; + E : Task_Entry_Index; + With_Abort : Boolean); + -- Requeue from a task entry to a task entry. + -- Compiler interface only. Do not call from within the RTS. + -- The code generation for task entry requeues is different from that for + -- protected entry requeues. There is a "goto" that skips around the call + -- to Complete_Rendezvous, so that Requeue_Task_Entry must also do the work + -- of Complete_Rendezvous. The difference is that it does not report that + -- the call's State = Done. + -- + -- source: + -- accept e1 do + -- ...A... + -- requeue e2; + -- ...B... + -- end e1; + -- + -- expansion: + -- A62b : address; + -- L61b : label + -- begin + -- accept_call (1, A62b); + -- ...A... + -- requeue_task_entry (tTV!(t)._task_id, 2, false); + -- goto L61b; + -- ...B... + -- complete_rendezvous; + -- <> + -- exception + -- when others => + -- exceptional_complete_rendezvous (current_exception); + -- end; + + procedure Requeue_Protected_To_Task_Entry + (Object : STPE.Protection_Entries_Access; + Acceptor : Task_Id; + E : Task_Entry_Index; + With_Abort : Boolean); + -- Requeue from a protected entry to a task entry. + -- Compiler interface only. Do not call from within the RTS. + -- + -- source: + -- entry e2 when b is + -- begin + -- b := false; + -- ...A... + -- requeue t.e2; + -- end e2; + -- + -- expansion: + -- procedure rPT__E14b (O : address; P : address; E : + -- protected_entry_index) is + -- type rTVP is access rTV; + -- freeze rTVP [] + -- _object : rTVP := rTVP!(O); + -- begin + -- declare + -- rR : protection renames _object._object; + -- vP : integer renames _object.v; + -- bP : boolean renames _object.b; + -- begin + -- b := false; + -- ...A... + -- requeue_protected_to_task_entry (rR'unchecked_access, tTV!(t). + -- _task_id, 2, false); + -- return; + -- end; + -- complete_entry_body (_object._object'unchecked_access, objectF => + -- 0); + -- return; + -- exception + -- when others => + -- abort_undefer.all; + -- exceptional_complete_entry_body (_object._object' + -- unchecked_access, current_exception, objectF => 0); + -- return; + -- end rPT__E14b; + + procedure Selective_Wait + (Open_Accepts : Accept_List_Access; + Select_Mode : Select_Modes; + Uninterpreted_Data : out System.Address; + Index : out Select_Index); + -- Implement select statement. + -- Compiler interface only. Do not call from within the RTS. + -- See comments on Accept_Call. + -- + -- source: + -- select accept e1 do + -- ...A... + -- end e1; + -- ...B... + -- or accept e2; + -- ...C... + -- end select; + -- + -- expansion: + -- A32b : address; + -- declare + -- A37b : T36b; + -- A37b (1) := (null_body => false, s => 1); + -- A37b (2) := (null_body => true, s => 2); + -- S0 : aliased T36b := accept_list'A37b; + -- J1 : select_index := 0; + -- procedure e1A is + -- begin + -- abort_undefer.all; + -- ...A... + -- <> + -- complete_rendezvous; + -- exception + -- when all others => + -- exceptional_complete_rendezvous (get_gnat_exception); + -- end e1A; + -- begin + -- selective_wait (S0'unchecked_access, simple_mode, A32b, J1); + -- case J1 is + -- when 0 => + -- goto L3; + -- when 1 => + -- e1A; + -- goto L1; + -- when 2 => + -- goto L2; + -- when others => + -- goto L3; + -- end case; + -- <> + -- ...B... + -- goto L3; + -- <> + -- ...C... + -- goto L3; + -- <> + -- end; + + procedure Timed_Selective_Wait + (Open_Accepts : Accept_List_Access; + Select_Mode : Select_Modes; + Uninterpreted_Data : out System.Address; + Timeout : Duration; + Mode : Delay_Modes; + Index : out Select_Index); + -- Selective wait with timeout without using ATC. + -- Compiler interface only. Do not call from within the RTS. + + procedure Accept_Call + (E : Task_Entry_Index; + Uninterpreted_Data : out System.Address); + -- Accept an entry call. + -- Compiler interface only. Do not call from within the RTS. + -- + -- source: + -- accept E do ...A... end E; + -- expansion: + -- A27b : address; + -- L26b : label + -- begin + -- accept_call (1, A27b); + -- ...A... + -- complete_rendezvous; + -- <> + -- exception + -- when all others => + -- exceptional_complete_rendezvous (get_gnat_exception); + -- end; + -- + -- The handler for Abort_Signal (*all* others) is to handle the case when + -- the acceptor is aborted between Accept_Call and the corresponding + -- Complete_Rendezvous call. We need to wake up the caller in this case. + -- + -- See also Selective_Wait + + procedure Accept_Trivial (E : Task_Entry_Index); + -- Accept an entry call that has no parameters and no body. + -- Compiler interface only. Do not call from within the RTS. + -- This should only be called when there is no accept body, or the accept + -- body is empty. + -- + -- source: + -- accept E; + -- expansion: + -- accept_trivial (1); + -- + -- The compiler is also able to recognize the following and + -- translate it the same way. + -- + -- accept E do null; end E; + + function Task_Count (E : Task_Entry_Index) return Natural; + -- Return number of tasks waiting on the entry E (of current task) + -- Compiler interface only. Do not call from within the RTS. + + function Callable (T : Task_Id) return Boolean; + -- Return T'Callable + -- Compiler interface. Do not call from within the RTS, except for body of + -- Ada.Task_Identification. + + type Task_Entry_Nesting_Depth is new Task_Entry_Index + range 0 .. Max_Task_Entry; + + function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id; + -- Return E'Caller. This will only work if called from within an + -- accept statement that is handling E, as required by the LRM (C.7.1(14)). + -- Compiler interface only. Do not call from within the RTS. + + procedure Complete_Rendezvous; + -- Called by acceptor to wake up caller + + procedure Exceptional_Complete_Rendezvous + (Ex : Ada.Exceptions.Exception_Id); + -- Called by acceptor to mark the end of the current rendezvous and + -- propagate an exception to the caller. + + -- For internal use only: + + function Task_Do_Or_Queue + (Self_ID : Task_Id; + Entry_Call : Entry_Call_Link) return Boolean; + -- Call this only with abort deferred and holding no locks, except + -- the global RTS lock when Single_Lock is True which must be owned. + -- Returns False iff the call cannot be served or queued, as is the + -- case if the caller is not callable; i.e., a False return value + -- indicates that Tasking_Error should be raised. + -- Either initiate the entry call, such that the accepting task is + -- free to execute the rendezvous, queue the call on the acceptor's + -- queue, or cancel the call. Conditional calls that cannot be + -- accepted immediately are cancelled. + +end System.Tasking.Rendezvous; -- cgit v1.2.3