# HP/PA HP-UX 10
ifeq ($(strip $(filter-out hppa% hp hpux10%,$(target_cpu) $(target_vendor) $(target_os))),)
LIBGNAT_TARGET_PAIRS = \
- a-excpol.adb<libgnat/a-excpol__abort.adb \
a-intnam.ads<libgnarl/a-intnam__hpux.ads \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-interr.adb<libgnarl/s-interr__sigaction.adb \
endif
LIBGNAT_TARGET_PAIRS += \
a-dirval.adb<libgnat/a-dirval__mingw.adb \
- a-excpol.adb<libgnat/a-excpol__abort.adb \
s-gloloc.adb<libgnat/s-gloloc__mingw.adb \
s-inmaop.adb<libgnarl/s-inmaop__dummy.adb \
s-taspri.ads<libgnarl/s-taspri__mingw.ads \
If this pragma is used on a target where this feature is not supported,
then the pragma will be ignored. See also ``pragma Linker_Section``.
-Pragma Polling
-==============
-
-Syntax:
-
-
-.. code-block:: ada
-
- pragma Polling (ON | OFF);
-
-
-This pragma controls the generation of polling code. This is normally off.
-If ``pragma Polling (ON)`` is used then periodic calls are generated to
-the routine ``Ada.Exceptions.Poll``. This routine is a separate unit in the
-runtime library, and can be found in file :file:`a-excpol.adb`.
-
-Pragma ``Polling`` can appear as a configuration pragma (for example it
-can be placed in the :file:`gnat.adc` file) to enable polling globally, or it
-can be used in the statement or declaration sequence to control polling
-more locally.
-
-A call to the polling routine is generated at the start of every loop and
-at the start of every subprogram call. This guarantees that the ``Poll``
-routine is called frequently, and places an upper bound (determined by
-the complexity of the code) on the period between two ``Poll`` calls.
-
-The primary purpose of the polling interface is to enable asynchronous
-aborts on targets that cannot otherwise support it (for example Windows
-NT), but it may be used for any other purpose requiring periodic polling.
-The standard version is null, and can be replaced by a user program. This
-will require re-compilation of the ``Ada.Exceptions`` package that can
-be found in files :file:`a-except.ads` and :file:`a-except.adb`.
-
-A standard alternative unit (in file :file:`4wexcpol.adb` in the standard GNAT
-distribution) is used to enable the asynchronous abort capability on
-targets that do not normally support the capability. The version of
-``Poll`` in this file makes a call to the appropriate runtime routine
-to test for an abort condition.
-
-Note that polling can also be enabled by use of the *-gnatP* switch.
-See the section on switches for gcc in the :title:`GNAT User's Guide`.
-
Pragma Post
===========
.. index:: Post
Cancel effect of previous :switch:`-gnatp` switch.
-.. index:: -gnatP (gcc)
-
-:switch:`-gnatP`
- Enable polling. This is required on some systems (notably Windows NT) to
- obtain asynchronous abort and asynchronous transfer of control capability.
- See ``Pragma_Polling`` in the :title:`GNAT_Reference_Manual` for full
- details.
-
-
.. index:: -gnatq (gcc)
:switch:`-gnatq`
Overriding_Renamings
Partition_Elaboration_Policy
Persistent_BSS
- Polling
Prefix_Exception_Messages
Priority_Specific_Dispatching
Profile
Analyze (N);
end Expand_Formal_Container_Element_Loop;
- -----------------------------
- -- Expand_N_Goto_Statement --
- -----------------------------
-
- -- Add poll before goto if polling active
-
- procedure Expand_N_Goto_Statement (N : Node_Id) is
- begin
- Generate_Poll_Call (N);
- end Expand_N_Goto_Statement;
-
---------------------------
-- Expand_N_If_Statement --
---------------------------
-- 4. Deal with while loops where Condition_Actions is set
-- 5. Deal with loops over predicated subtypes
-- 6. Deal with loops with iterators over arrays and containers
- -- 7. Insert polling call if required
procedure Expand_N_Loop_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Adjust_Condition (Condition (Scheme));
end if;
- -- Generate polling call
-
- if Is_Non_Empty_List (Statements (N)) then
- Generate_Poll_Call (First (Statements (N)));
- end if;
-
-- Nothing more to do for plain loop with no iteration scheme
if No (Scheme) then
procedure Expand_N_Block_Statement (N : Node_Id);
procedure Expand_N_Case_Statement (N : Node_Id);
procedure Expand_N_Exit_Statement (N : Node_Id);
- procedure Expand_N_Goto_Statement (N : Node_Id);
procedure Expand_N_If_Statement (N : Node_Id);
procedure Expand_N_Loop_Statement (N : Node_Id);
-- Expand_N_Subprogram_Body --
------------------------------
- -- Add poll call if ATC polling is enabled, unless the body will be inlined
- -- by the back-end.
-
-- Add dummy push/pop label nodes at start and end to clear any local
-- exception indications if local-exception-to-goto optimization is active.
end;
end if;
- -- Need poll on entry to subprogram if polling enabled. We only do this
- -- for non-empty subprograms, since it does not seem necessary to poll
- -- for a dummy null subprogram.
-
- if Is_Non_Empty_List (L) then
-
- -- Do not add a polling call if the subprogram is to be inlined by
- -- the back-end, to avoid repeated calls with multiple inlinings.
-
- if Is_Inlined (Spec_Id)
- and then Front_End_Inlining
- and then Optimization_Level > 1
- then
- null;
- else
- Generate_Poll_Call (First (L));
- end if;
- end if;
-
-- Initialize any scalar OUT args if Initialize/Normalize_Scalars
if Init_Or_Norm_Scalars and then Is_Subprogram (Spec_Id) then
Fin_Id : Entity_Id;
Mark : Entity_Id := Empty;
New_Decls : List_Id;
- Old_Poll : Boolean;
begin
-- If we are generating expanded code for debugging purposes, use the
Loc := No_Location;
end if;
- -- Set polling off. The finalization and cleanup code is executed
- -- with aborts deferred.
-
- Old_Poll := Polling_Required;
- Polling_Required := False;
-
-- A task activation call has already been built for a task
-- allocation block.
if Present (Fin_Id) then
Build_Finalizer_Call (N, Fin_Id);
end if;
-
- -- Restore saved polling mode
-
- Polling_Required := Old_Poll;
end;
end Expand_Cleanup_Actions;
return End_String;
end Fully_Qualified_Name_String;
- ------------------------
- -- Generate_Poll_Call --
- ------------------------
-
- procedure Generate_Poll_Call (N : Node_Id) is
- begin
- -- No poll call if polling not active
-
- if not Polling_Required then
- return;
-
- -- Otherwise generate require poll call
-
- else
- Insert_Before_And_Analyze (N,
- Make_Procedure_Call_Statement (Sloc (N),
- Name => New_Occurrence_Of (RTE (RE_Poll), Sloc (N))));
- end if;
- end Generate_Poll_Call;
-
---------------------------------
-- Get_Current_Value_Condition --
---------------------------------
-- of entity E, in all upper case, with an ASCII.NUL appended at the end
-- of the name if Append_NUL is True.
- procedure Generate_Poll_Call (N : Node_Id);
- -- If polling is active, then a call to the Poll routine is built,
- -- and then inserted before the given node N and analyzed.
-
procedure Get_Current_Value_Condition
(Var : Node_Id;
Op : out Node_Kind;
when N_Generic_Instantiation =>
Expand_N_Generic_Instantiation (N);
- when N_Goto_Statement =>
- Expand_N_Goto_Statement (N);
-
when N_Handled_Sequence_Of_Statements =>
Expand_N_Handled_Sequence_Of_Statements (N);
Xref_Active := True;
- -- Polling mode forced off, since it generates confusing junk
-
- Polling_Required := False;
-
-- Set operating mode to Generate_Code to benefit from full front-end
-- expansion (e.g. generics).
Xref_Active := True;
- -- Polling mode forced off, since it generates confusing junk
-
- Polling_Required := False;
-
-- Set operating mode to Check_Semantics, but a light front-end
-- expansion is still performed.
@copying
@quotation
-GNAT User's Guide for Native Platforms , Jul 01, 2020
+GNAT User's Guide for Native Platforms , Sep 29, 2020
AdaCore
Overriding_Renamings
Partition_Elaboration_Policy
Persistent_BSS
-Polling
Prefix_Exception_Messages
Priority_Specific_Dispatching
Profile
Cancel effect of previous @code{-gnatp} switch.
@end table
-@geindex -gnatP (gcc)
-
-
-@table @asis
-
-@item @code{-gnatP}
-
-Enable polling. This is required on some systems (notably Windows NT) to
-obtain asynchronous abort and asynchronous transfer of control capability.
-See @code{Pragma_Polling} in the @cite{GNAT_Reference_Manual} for full
-details.
-@end table
-
@geindex -gnatq (gcc)
-- This is a AIX (Native) version of this package
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
package body System.OS_Interface is
use Interfaces.C;
-- This is an Android version of this package.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This is a Darwin Threads version of this package
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
with Interfaces.C.Extensions;
package body System.OS_Interface is
-- This is the GNU/Hurd version of this package.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This is a DCE version of this package.
-- Currently HP-UX and SNI use this file
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- Version of System.OS_Interface for LynxOS-178 (POSIX Threads)
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It may cause infinite loops and other problems.
-
package body System.OS_Interface is
------------------
-- This version is for POSIX-like operating systems
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This version is for QNX operating systems
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
with Interfaces.C; use Interfaces.C;
+
package body System.OS_Interface is
-----------------
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-- This package encapsulates all direct interfaces to OS services that are
-- needed by children of System.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
package body System.OS_Interface is
use type Interfaces.C.int;
-- This version is for Linux/x32
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
with Interfaces.C; use Interfaces.C;
+
package body System.OS_Interface is
--------------------
-- Turn off subprogram alpha ordering check, since we group soft link bodies
-- and dummy soft link bodies together separately in this unit.
-pragma Polling (Off);
--- Turn polling off for this package. We don't need polling during any of the
--- routines in this package, and more to the point, if we try to poll it can
--- cause infinite loops.
-
with Ada.Exceptions;
with Ada.Exceptions.Is_Null_Occurrence;
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with Ada.Task_Identification;
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.Task_Primitives.Operations;
with System.Soft_Links.Tasking;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
package body System.Task_Primitives.Operations is
use System.Tasking;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with Interfaces.C;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Interfaces.C; use Interfaces; use type Interfaces.C.int;
with System.Task_Info;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Interfaces.C;
with Interfaces.C.Strings;
-- For configurations where SCHED_FIFO and priority ceiling are not a
-- requirement, this file can also be used (e.g AiX threads)
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with Interfaces.C;
-- For configurations where SCHED_FIFO and priority ceiling are not a
-- requirement, this file can also be used (e.g AiX threads)
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with Interfaces.C;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Interfaces.C;
with System.Multiprocessors;
-- This package contains all the GNULL primitives that interface directly with
-- the underlying OS.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with Interfaces.C;
-- This package represents the high level tasking interface used by the
-- compiler to expand Ada 95 tasking constructs into simpler run time calls.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during
--- tasking operations. It causes infinite loops and other problems.
-
with Ada.Exceptions;
with System.Task_Primitives.Operations;
-- Turn off subprogram alpha ordering check, since we group soft link bodies
-- and dummy soft link bodies together separately in this unit.
-pragma Polling (Off);
--- Turn polling off for this package. We don't need polling during any of the
--- routines in this package, and more to the point, if we try to poll it can
--- cause infinite loops.
-
with System.Task_Primitives;
with System.Task_Primitives.Operations;
with System.Soft_Links;
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.Task_Primitives.Operations;
with System.Storage_Elements;
-- This is a no tasking version of this package
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
package System.Task_Primitives is
pragma Preelaborate;
-- This package provides low-level support for most tasking features
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
package System.Task_Primitives is
-- This is LynxOS Family version of this package.
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
package System.Task_Primitives is
-- This is a NT (native) version of this package
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
with System.Win32;
-- Note: this file can only be used for POSIX compliant systems
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
package System.Task_Primitives is
-- Note: this file can only be used for POSIX compliant systems
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
package System.Task_Primitives is
-- This package provides low-level support for most tasking features
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with Ada.Unchecked_Conversion;
with System.OS_Interface;
-- This is a VxWorks version of this package
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.OS_Interface;
package System.Task_Primitives is
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
pragma Partition_Elaboration_Policy (Concurrent);
-- This package only implements the concurrent elaboration policy. This pragma
-- will enforce it (and detect conflicts with user specified policy).
-- These declarations are not part of the GNARLI
-pragma Polling (Off);
--- Turn off polling, we do not want ATC polling to take place during tasking
--- operations. It causes infinite loops and other problems.
-
with System.Tasking.Debug;
with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
-- performed at compile time, and is relatively cheap (see PO_Do_Or_Queue,
-- Service_Entry).
-pragma Polling (Off);
--- Turn off polling, we do not want polling to take place during tasking
--- operations. It can cause infinite loops and other problems.
-
pragma Suppress (All_Checks);
-- Why is this required ???
pragma Style_Checks (All_Checks);
-- No subprogram ordering check, due to logical grouping
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with System.Exception_Tables.
-
with System; use System;
with System.Exceptions; use System.Exceptions;
with System.Exceptions_Debug; use System.Exceptions_Debug;
Rmsg_36 : constant String := "stream operation not allowed" & NUL;
Rmsg_37 : constant String := "build-in-place mismatch" & NUL;
- -----------------------
- -- Polling Interface --
- -----------------------
-
- type Unsigned is mod 2 ** 32;
-
- Counter : Unsigned := 0;
- pragma Warnings (Off, Counter);
- -- This counter is provided for convenience. It can be used in Poll to
- -- perform periodic but not systematic operations.
-
- procedure Poll is separate;
- -- The actual polling routine is separate, so that it can easily be
- -- replaced with a target dependent version.
-
--------------------------
-- Code_Address_For_AAA --
--------------------------
-- This is the default version of this package. We also have cert and zfp
-- versions.
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with ourself.
-
with System;
with System.Parameters;
with System.Standard_Library;
-- Determine whether the current exception (if it exists) is an instance of
-- Standard'Abort_Signal.
- -----------------------
- -- Polling Interface --
- -----------------------
-
- -- The GNAT compiler has an option to generate polling calls to the Poll
- -- routine in this package. Specifying the -gnatP option for a compilation
- -- causes a call to Ada.Exceptions.Poll to be generated on every subprogram
- -- entry and on every iteration of a loop, thus avoiding the possibility of
- -- a case of unbounded time between calls.
-
- -- This polling interface may be used for instrumentation or debugging
- -- purposes (e.g. implementing watchpoints in software or in the debugger).
-
- -- In the GNAT technology itself, this interface is used to implement
- -- immediate asynchronous transfer of control and immediate abort on
- -- targets which do not provide for one thread interrupting another.
-
- -- Note: this used to be in a separate unit called System.Poll, but that
- -- caused horrible circular elaboration problems between System.Poll and
- -- Ada.Exceptions.
-
- procedure Poll;
- -- Check for asynchronous abort. Note that we do not inline the body.
- -- This makes the interface more useful for debugging purposes.
-
--------------------------
-- Exception_Occurrence --
--------------------------
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- A D A . E X C E P T I O N S . P O L L --
--- --
--- B o d y --
--- (dummy version where polling is not used) --
--- --
--- Copyright (C) 1992-2020, 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 --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
-separate (Ada.Exceptions)
-
-----------
--- Poll --
-----------
-
-procedure Poll is
-begin
- null;
-end Poll;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- A D A . E X C E P T I O N S . P O L L --
--- (version supporting asynchronous abort test) --
--- --
--- B o d y --
--- --
--- Copyright (C) 1992-2020, 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 --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for targets that do not support per-thread asynchronous
--- signals. On such targets, we require compilation with the -gnatP switch
--- that activates periodic polling. Then in the body of the polling routine
--- we test for asynchronous abort.
-
--- Windows and HPUX 10 currently use this file
-
-pragma Warnings (Off);
--- Allow withing of non-Preelaborated units in Ada 2005 mode where this
--- package will be categorized as Preelaborate. See AI-362 for details.
--- It is safe in the context of the run-time to violate the rules.
-
-with System.Soft_Links;
-
-pragma Warnings (On);
-
-separate (Ada.Exceptions)
-
-----------
--- Poll --
-----------
-
-procedure Poll is
-begin
- -- Test for asynchronous abort on each poll
-
- if System.Soft_Links.Check_Abort_Status.all /= 0 then
- raise Standard'Abort_Signal;
- end if;
-end Poll;
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we can get
--- elaboration circularities when polling is turned on
-
with Ada.Characters.Handling;
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
with Ada.Unchecked_Deallocation;
-- size is a consideration it's possible to strip all other .debug sections,
-- which will decrease the size of the object significantly.
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we can get
--- elaboration circularities when polling is turned on
-
with Ada.Exceptions.Traceback;
with System.Object_Reader;
pragma Compiler_Unit_Warning;
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with System.Exception_Tables.
-
with System.Storage_Elements;
package System.Machine_State_Operations is
pragma Compiler_Unit_Warning;
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get an
--- infinite loop from the code within the Poll routine itself.
-
pragma Warnings (Off);
-- Disable warnings as System.Soft_Links.Initialize is not Preelaborate. It is
-- safe to with this unit as its elaboration routine will only be initializing
-- of System.Standard_Library, since this would cause order of elaboration
-- problems (Elaborate_Body would have the same problem).
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with Ada.Exceptions if polling is on.
-
pragma Warnings (Off);
-- Kill warnings from unused withs. These unused with's are here to make
-- sure the relevant units are loaded and properly elaborated.
pragma Compiler_Unit_Warning;
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with Ada.Exceptions if polling is on.
-
with Ada.Unchecked_Conversion;
package System.Standard_Library is
-- cache is pending, that write should be followed by a Poll to prevent
-- losing signals.
--
- -- Note: This function must be compiled with Polling turned off
- --
-- Note: on systems with real thread-local storage, Set_Stack_Info should
-- return an access value for such local storage. In those cases the cache
-- will always be up-to-date.
-- We want to guarantee the absence of elaboration code because the binder
-- does not handle references to this package.
-pragma Polling (Off);
--- Turn off polling, we do not want polling to take place during stack
--- checking operations. It causes infinite loops and other problems.
-
with System.Storage_Elements;
package System.Stack_Checking.Operations is
-- We want to guarantee the absence of elaboration code because the binder
-- does not handle references to this package.
-pragma Polling (Off);
--- Turn off polling, we do not want polling to take place during stack
--- checking operations. It causes infinite loops and other problems.
-
package System.Stack_Checking.Operations is
pragma Preelaborate;
pragma Compiler_Unit_Warning;
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with System.Exception_Tables.
-
with System.Traceback_Entries;
package System.Traceback is
-- --
------------------------------------------------------------------------------
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with Ada.Exceptions.
-
pragma Compiler_Unit_Warning;
package body System.Traceback_Entries is
-- version of the package, an entry is a mere code location representing the
-- address of a call instruction part of the call-chain.
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we get
--- elaboration circularities with Ada.Exceptions.
-
pragma Compiler_Unit_Warning;
package System.Traceback_Entries is
-- is not supported. It returns tracebacks as lists of hexadecimal addresses
-- of the form "0x...".
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we can get
--- elaboration circularities when polling is turned on.
-
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
with System.Address_Image;
-- executable. You should consider using gdb to obtain symbolic traceback in
-- such cases.
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we can get
--- elaboration circularities when polling is turned on.
-
with Ada.Exceptions;
package System.Traceback.Symbolic is
-- Run-time symbolic traceback support for targets using DWARF debug data
-pragma Polling (Off);
--- We must turn polling off for this unit, because otherwise we can get
--- elaboration circularities when polling is turned on.
-
with Ada.Unchecked_Deallocation;
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
No_Component_Reordering_Config := No_Component_Reordering;
Optimize_Alignment_Config := Optimize_Alignment;
Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
- Polling_Required_Config := Polling_Required;
Prefix_Exception_Messages_Config := Prefix_Exception_Messages;
SPARK_Mode_Config := SPARK_Mode;
SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
Optimize_Alignment := Save.Optimize_Alignment;
Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
- Polling_Required := Save.Polling_Required;
Prefix_Exception_Messages := Save.Prefix_Exception_Messages;
SPARK_Mode := Save.SPARK_Mode;
SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
Optimize_Alignment => Optimize_Alignment,
Optimize_Alignment_Local => Optimize_Alignment_Local,
Persistent_BSS_Mode => Persistent_BSS_Mode,
- Polling_Required => Polling_Required,
Prefix_Exception_Messages => Prefix_Exception_Messages,
SPARK_Mode => SPARK_Mode,
SPARK_Mode_Pragma => SPARK_Mode_Pragma,
Default_Pool := Default_Pool_Config;
Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
Fast_Math := Fast_Math_Config;
- Polling_Required := Polling_Required_Config;
end Set_Config_Switches;
end Opt;
-- GNATBIND
-- True if pessimistic elaboration order is to be chosen (-p switch set)
- Polling_Required : Boolean := False;
- -- GNAT
- -- Set to True if polling for asynchronous abort is enabled by using
- -- the -gnatP option for GNAT.
-
Prefix_Exception_Messages : Boolean := False;
-- GNAT
-- Set True to prefix exception messages with entity-name:
-- at the start of each compilation unit, except that it is always
-- set False for predefined units.
- Polling_Required_Config : Boolean;
- -- GNAT
- -- This is the value of the configuration switch that controls polling
- -- mode. It can be set True by the command line switch -gnatP, and then
- -- further modified by the use of pragma Polling in the gnat.adc file. This
- -- flag is used to set the initial value for Polling_Required at the start
- -- of analyzing each unit.
-
Prefix_Exception_Messages_Config : Boolean;
-- The setting of Prefix_Exception_Messages from configuration pragmas
Optimize_Alignment : Character;
Optimize_Alignment_Local : Boolean;
Persistent_BSS_Mode : Boolean;
- Polling_Required : Boolean;
Prefix_Exception_Messages : Boolean;
SPARK_Mode : SPARK_Mode_Type;
SPARK_Mode_Pragma : Node_Id;
| Pragma_Partition_Elaboration_Policy
| Pragma_Passive
| Pragma_Persistent_BSS
- | Pragma_Polling
| Pragma_Post
| Pragma_Post_Class
| Pragma_Postcondition
Map_Pragma_Name (From => Chars (New_Name), To => Chars (Old_Name));
end Rename_Pragma;
- -------------
- -- Polling --
- -------------
-
- -- pragma Polling (ON | OFF);
-
- when Pragma_Polling =>
- GNAT_Pragma;
- Check_Arg_Count (1);
- Check_No_Identifiers;
- Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
- Polling_Required := (Chars (Get_Pragma_Arg (Arg1)) = Name_On);
-
-----------------------------------
-- Post/Post_Class/Postcondition --
-----------------------------------
Pragma_Partition_Elaboration_Policy => 0,
Pragma_Passive => 0,
Pragma_Persistent_BSS => 0,
- Pragma_Polling => 0,
Pragma_Post => -1,
Pragma_Postcondition => -1,
Pragma_Post_Class => -1,
Name_Overriding_Renamings : constant Name_Id := N + $; -- GNAT
Name_Partition_Elaboration_Policy : constant Name_Id := N + $; -- Ada 05
Name_Persistent_BSS : constant Name_Id := N + $; -- GNAT
- Name_Polling : constant Name_Id := N + $; -- GNAT
Name_Prefix_Exception_Messages : constant Name_Id := N + $; -- GNAT
Name_Priority_Specific_Dispatching : constant Name_Id := N + $; -- Ada 05
Name_Profile : constant Name_Id := N + $; -- Ada 05
Pragma_Overriding_Renamings,
Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
- Pragma_Polling,
Pragma_Prefix_Exception_Messages,
Pragma_Priority_Specific_Dispatching,
Pragma_Profile,
when 'P' =>
Treat_Categorization_Errors_As_Warnings := True;
+ Ptr := Ptr + 1;
-- -gnates=file (specify extra file switches for gnat2why)
-- -gnateu (unrecognized y,V,w switches)
when 'u' =>
- Ptr := Ptr + 1;
Ignore_Unrecognized_VWY_Switches := True;
+ Ptr := Ptr + 1;
-- -gnateV (validity checks on parameters)
Suppress_Options.Overflow_Mode_Assertions := Strict;
end if;
- -- -gnatP (periodic poll)
-
- when 'P' =>
- Ptr := Ptr + 1;
- Polling_Required := True;
-
-- -gnatq (don't quit)
when 'q' =>
Opt.Partition_Elaboration_Policy_Sloc := System_Location;
goto Line_Loop_Continue;
- -- Polling (On)
-
- elsif Looking_At_Skip ("pragma Polling (On);") then
- Opt.Polling_Required := True;
- goto Line_Loop_Continue;
-
-- Queuing Policy
elsif Looking_At_Skip ("pragma Queuing_Policy (") then
-- policy name, and Opt.Task_Dispatching_Policy_Sloc is set to
-- System_Location.
- -- If a pragma Polling (On) appears, then the flag Opt.Polling_Required
- -- is set to True.
-
-- If a pragma Detect_Blocking appears, then the flag Opt.Detect_Blocking
-- is set to True.
Write_Switch_Char ("p");
Write_Line ("Suppress all checks");
- -- Line for -gnatP switch
-
- Write_Switch_Char ("P");
- Write_Line ("Generate periodic calls to System.Polling.Poll");
-
-- Line for -gnatq switch
Write_Switch_Char ("q");
projects / gcc.git / commitdiff