s-inmaop$(objext) \
s-interr$(objext) \
s-intman$(objext) \
+ s-intnam$(objext) \
+ s-inttyp$(objext) \
s-mudido$(objext) \
s-osinte$(objext) \
s-proinf$(objext) \
if [ -f $(RTSDIR)/$$f ]; then echo $$f >> $(RTSDIR)/libgnarl.lst; fi \
done
@echo thread.c >> $(RTSDIR)/libgnarl.lst
+# s-intnam.ads is generated later, so hardcode it here
+ @echo s-intnam.ads >> $(RTSDIR)/libgnarl.lst
@for f in \
$(foreach F,$(GNATRTL_NONTASKING_OBJS),$(subst $(objext),.ads,$(F))) \
$(foreach F,$(GNATRTL_NONTASKING_OBJS),$(subst $(objext),.adb,$(F))); \
$(OSCONS_EXTRACT) ; \
../bldtools/oscons/xoscons s-oscons)
-gnatlib: ../stamp-gnatlib1-$(RTSDIR) ../stamp-gnatlib2-$(RTSDIR) $(RTSDIR)/s-oscons.ads
+$(RTSDIR)/a-intnam.ads: ../stamp-gnatlib1-$(RTSDIR)
+ touch $@
+
+$(RTSDIR)/s-intnam.ads: $(fsrcdir)/ada/xsintnam.sed $(RTSDIR)/a-intnam.ads
+ sed -E -f $(fsrcdir)/ada/xsintnam.sed $(RTSDIR)/a-intnam.ads | cat -s > $@
+
+gnatlib: ../stamp-gnatlib1-$(RTSDIR) ../stamp-gnatlib2-$(RTSDIR) $(RTSDIR)/s-oscons.ads $(RTSDIR)/s-intnam.ads
test -f $(RTSDIR)/s-oscons.ads || exit 1
+ test -f $(RTSDIR)/s-intnam.ads || exit 1
# C files
$(MAKE) -C $(RTSDIR) \
CC="$(GCC_FOR_ADA_RTS)" \
with Ada.Unchecked_Conversion;
+with System.Interrupts;
+
package body Ada.Interrupts is
package SI renames System.Interrupts;
-- --
------------------------------------------------------------------------------
-with System.Interrupts;
+with System.Interrupt_Types;
with System.Multiprocessors;
with Ada.Task_Identification;
package Ada.Interrupts is
- type Interrupt_ID is new System.Interrupts.Ada_Interrupt_ID;
+ type Interrupt_ID is new System.Interrupt_Types.Preelab_Interrupt_ID;
type Parameterless_Handler is access protected procedure;
-- used without requiring the whole tasking implementation to be linked and
-- elaborated.
+with System.Interrupt_Types;
with System.Tasking;
with System.Tasking.Protected_Objects.Entries;
-with System.OS_Interface;
package System.Interrupts is
-- Default value used when a pragma Interrupt_Handler or Attach_Handler is
-- specified without an Interrupt_Priority pragma, see D.3(10).
- type Ada_Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
- -- Avoid inheritance by Ada.Interrupts.Interrupt_ID of unwanted operations
-
- type Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
+ type Interrupt_ID is new System.Interrupt_Types.Preelab_Interrupt_ID;
subtype System_Interrupt_Id is Interrupt_ID;
-- This synonym is introduced so that the type is accessible through
-- Default value used when a pragma Interrupt_Handler or Attach_Handler is
-- specified without an Interrupt_Priority pragma, see D.3(10).
- type Ada_Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
- -- Avoid inheritance by Ada.Interrupts.Interrupt_ID of unwanted operations
-
type Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
subtype System_Interrupt_Id is Interrupt_ID;
--- /dev/null
+with System.OS_Interface;
+
+package System.Interrupt_Types
+ with Preelaborate
+is
+ type Preelab_Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt;
+end System.Interrupt_Types;
System_Img_LLLU,
System_Img_Uns,
System_Img_WChar,
+ System_Interrupt_Names,
+ System_Interrupt_Types,
System_Interrupts,
System_Long_Long_Float_Expon,
System_Machine_Code,
RE_Image_Wide_Character, -- System.Img_WChar
RE_Image_Wide_Wide_Character, -- System.Img_WChar
+ RE_Interrupt_Names, -- System.Interrupt_Names
+
+ RE_Preelab_Interrupt_ID, -- System.Interrupt_Types
+
RE_Bind_Interrupt_To_Entry, -- System.Interrupts
RE_Default_Interrupt_Priority, -- System.Interrupts
RE_Dynamic_Interrupt_Protection, -- System.Interrupts
RE_Image_Wide_Character => System_Img_WChar,
RE_Image_Wide_Wide_Character => System_Img_WChar,
+ RE_Interrupt_Names => System_Interrupt_Names,
+
+ RE_Preelab_Interrupt_ID => System_Interrupt_Types,
+
RE_Bind_Interrupt_To_Entry => System_Interrupts,
RE_Default_Interrupt_Priority => System_Interrupts,
RE_Dynamic_Interrupt_Protection => System_Interrupts,
-- given as a static integer expression which must be in the range of
-- Ada.Interrupts.Interrupt_ID.
+ -- Note: There are two places where the runtime does significant work
+ -- with interrupt/signals:
+ --
+ -- 1. __gnat_install_handler.
+ -- 2. Ada.Interrupts and its partition closure, at least for some
+ -- configurations of the runtime.
+ --
+ -- 1. kicks in by default whereas 2. only happens for applications
+ -- that have a with clause to Ada.Interrupts. Users who develop
+ -- mixed-language applications sometimes want to opt out of 1., and
+ -- pragma Interrupt_State is the preferred way to do that. So we
+ -- jump through a few hoops to make pragma Interrupt_State *not*
+ -- implicitly pull in Ada.Interrupts, as users who want to suppress
+ -- the effects of 1. surely don't want to enable the effects of 2.
+ --
+ -- The hoops in question are:
+ --
+ -- A. We have a Preelab_Interrupt_ID type in the runtime in a
+ -- preelaborate package. Interrupt_ID trivially derives from this
+ -- type, therefore we can correctly substitute
+ -- Preelab_Interrupt_ID for Interrupt_ID when analyzing
+ -- Interrupt_State pragmas.
+ -- B. The runtime configurations for which Ada.Interrupts has
+ -- significant side effects expose a preelaborate package,
+ -- System.Interrupt_Names, that mirrors Ada.Interrupts.Names. The
+ -- constant declarations of Ada.Interrupts.Names are replaced with
+ -- named numbers so there's no dependency on Ada.Interrupts.
+ -- System.Interrupt_Names is generated from Ada.Interrupts.Names
+ -- during the build of the runtime. Again, we can correctly
+ -- substitute System.Interrupt_Names for Ada.Interrupts.Names when
+ -- analyzing identifiers used in Interrupt_State pragmas.
+
when Pragma_Interrupt_State => Interrupt_State : declare
- Int_Id : constant Entity_Id := RTE (RE_Interrupt_ID);
- -- This is the entity Ada.Interrupts.Interrupt_ID;
+ Int_Id : constant Entity_Id := RTE (RE_Preelab_Interrupt_ID);
+ -- This is the entity System.Interrupt_Types.Ada_Interrupt_Id,
+ -- from which Ada.Interrupts.Interrupt_ID directly derives.
State_Type : Character;
-- Set to 's'/'r'/'u' for System/Runtime/User
Arg1X : constant Node_Id := Get_Pragma_Arg (Arg1);
-- The first argument to the pragma
+ Names_Package : constant Entity_Id :=
+ RTE
+ (if RTE_Available (RE_Interrupt_Names)
+ then RE_Interrupt_Names
+ else RE_Names);
+ -- The package we search for Interrupt_ID constants
+
Int_Ent : Entity_Id;
- -- Interrupt entity in Ada.Interrupts.Names
+ -- Interrupt entity in Names_Package
begin
GNAT_Pragma;
if Nkind (Arg1X) = N_Identifier then
- -- Search list of names in Ada.Interrupts.Names
+ -- Search list of names in Names_Package
- Int_Ent := First_Entity (RTE (RE_Names));
+ Int_Ent := First_Entity (Names_Package);
loop
if No (Int_Ent) then
Error_Pragma_Arg ("invalid interrupt name", Arg1);
--- /dev/null
+#Indicate that the output was generated.
+/package Ada.Interrupts.Names/i -- Generated from Ada.Interrupts.Names for use by pragma Interrupt_State
+
+#Turn constants into named numbers.
+s/constant Interrupt_ID/constant/g
+
+#Rename the package and add the Preelaborate aspect.
+s/package Ada.Interrupts.Names/package System.Interrupt_Names with Preelaborate/g
+s/end Ada.Interrupts.Names/end System.Interrupt_Names/g
+
+#Update the copyright header.
+/A D A . I N T E R R U P T S . N A M E S/c -- S Y S T E M . I N T E R R U P T S _ N A M E S --
+
+#Remove non-copyright-header comments.
+s/[[:blank:]]*-- [^ ].*//g
projects / thirdparty / gcc.git / commitdiff
