Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1);
begin
- GNAT_Pragma;
Check_Arg_Count (2);
Check_No_Identifiers;
Check_Arg_Is_Static_Expression (Arg2, Standard_String);
Code_Val : Uint;
begin
- GNAT_Pragma;
-
if not OpenVMS_On_Target then
Error_Pragma
("?pragma% ignored (applies only to Open'V'M'S)");
(Arg_Internal : Node_Id := Empty)
is
begin
- GNAT_Pragma;
-
if No (Arg_Internal) then
Error_Pragma ("Internal parameter required for pragma%");
end if;
Exp : Node_Id;
begin
- GNAT_Pragma;
Check_No_Identifiers;
Check_At_Least_N_Arguments (1);
-- pragma Comment (static_string_EXPRESSION)
- -- Processing for pragma Comment shares the circuitry for
- -- pragma Ident. The only differences are that Ident enforces
- -- a limit of 31 characters on its argument, and also enforces
- -- limitations on placement for DEC compatibility. Pragma
- -- Comment shares neither of these restrictions.
+ -- Processing for pragma Comment shares the circuitry for pragma
+ -- Ident. The only differences are that Ident enforces a limit of 31
+ -- characters on its argument, and also enforces limitations on
+ -- placement for DEC compatibility. Pragma Comment shares neither of
+ -- these restrictions.
-------------------
-- Common_Object --
-- (boolean_EXPRESSION, static_string_EXPRESSION);
when Pragma_Compile_Time_Error =>
+ GNAT_Pragma;
Process_Compile_Time_Warning_Or_Error;
--------------------------
-- (boolean_EXPRESSION, static_string_EXPRESSION);
when Pragma_Compile_Time_Warning =>
+ GNAT_Pragma;
Process_Compile_Time_Warning_Or_Error;
-------------------
when Pragma_CPP_Virtual => CPP_Virtual : declare
begin
+ GNAT_Pragma;
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_virtual is now obsolete and has " &
when Pragma_CPP_Vtable => CPP_Vtable : declare
begin
+ GNAT_Pragma;
+
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_vtable is now obsolete and has " &
Code : Node_Id renames Args (4);
begin
+ GNAT_Pragma;
+
if Inside_A_Generic then
Error_Pragma ("pragma% cannot be used for generic entities");
end if;
Typ : Entity_Id;
begin
+ GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
Code : Node_Id renames Args (4);
begin
+ GNAT_Pragma;
Gather_Associations (Names, Args);
if Present (External) and then Present (Code) then
-- pragma Inline_Always ( NAME {, NAME} );
when Pragma_Inline_Always =>
+ GNAT_Pragma;
Process_Inline (True);
--------------------
-- pragma Inline_Generic (NAME {, NAME});
when Pragma_Inline_Generic =>
+ GNAT_Pragma;
Process_Generic_List;
----------------------
-- it was misplaced.
when Pragma_No_Body =>
+ GNAT_Pragma;
Pragma_Misplaced;
---------------
end loop;
end No_Return;
+ -----------------
+ -- No_Run_Time --
+ -----------------
+
+ -- pragma No_Run_Time;
+
+ -- Note: this pragma is retained for backwards compatibility.
+ -- See body of Rtsfind for full details on its handling.
+
+ when Pragma_No_Run_Time =>
+ GNAT_Pragma;
+ Check_Valid_Configuration_Pragma;
+ Check_Arg_Count (0);
+
+ No_Run_Time_Mode := True;
+ Configurable_Run_Time_Mode := True;
+
+ -- Set Duration to 32 bits if word size is 32
+
+ if Ttypes.System_Word_Size = 32 then
+ Duration_32_Bits_On_Target := True;
+ end if;
+
+ -- Set appropriate restrictions
+
+ Set_Restriction (No_Finalization, N);
+ Set_Restriction (No_Exception_Handlers, N);
+ Set_Restriction (Max_Tasks, N, 0);
+ Set_Restriction (No_Tasking, N);
+
------------------------
-- No_Strict_Aliasing --
------------------------
-- pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)];
- when Pragma_No_Strict_Aliasing => No_Strict_Alias : declare
+ when Pragma_No_Strict_Aliasing => No_Strict_Aliasing : declare
E_Id : Entity_Id;
begin
Set_No_Strict_Aliasing (Implementation_Base_Type (E_Id));
end if;
- end No_Strict_Alias;
+ end No_Strict_Aliasing;
+
+ -----------------------
+ -- Normalize_Scalars --
+ -----------------------
+
+ -- pragma Normalize_Scalars;
+
+ when Pragma_Normalize_Scalars =>
+ Check_Ada_83_Warning;
+ Check_Arg_Count (0);
+ Check_Valid_Configuration_Pragma;
+ Normalize_Scalars := True;
+ Init_Or_Norm_Scalars := True;
-----------------
-- Obsolescent --
end if;
end Obsolescent;
- -----------------
- -- No_Run_Time --
- -----------------
-
- -- pragma No_Run_Time
-
- -- Note: this pragma is retained for backwards compatibility.
- -- See body of Rtsfind for full details on its handling.
-
- when Pragma_No_Run_Time =>
- GNAT_Pragma;
- Check_Valid_Configuration_Pragma;
- Check_Arg_Count (0);
-
- No_Run_Time_Mode := True;
- Configurable_Run_Time_Mode := True;
-
- -- Set Duration to 32 bits if word size is 32
-
- if Ttypes.System_Word_Size = 32 then
- Duration_32_Bits_On_Target := True;
- end if;
-
- -- Set appropriate restrictions
-
- Set_Restriction (No_Finalization, N);
- Set_Restriction (No_Exception_Handlers, N);
- Set_Restriction (Max_Tasks, N, 0);
- Set_Restriction (No_Tasking, N);
-
- -----------------------
- -- Normalize_Scalars --
- -----------------------
-
- -- pragma Normalize_Scalars;
-
- when Pragma_Normalize_Scalars =>
- Check_Ada_83_Warning;
- Check_Arg_Count (0);
- Check_Valid_Configuration_Pragma;
- Normalize_Scalars := True;
- Init_Or_Norm_Scalars := True;
-
--------------
-- Optimize --
--------------
end if;
end Preelab_Init;
- -------------
- -- 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 (Expression (Arg1)) = Name_On);
-
--------------------
-- Persistent_BSS --
--------------------
end if;
end Persistent_BSS;
+ -------------
+ -- 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 (Expression (Arg1)) = Name_On);
+
-------------------
-- Postcondition --
-------------------
-- or the identifier GCC, no other identifiers are acceptable.
when Pragma_System_Name =>
+ GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_One_Of (Arg1, Name_Gcc, Name_Gnat);
Variant : Node_Id;
begin
- GNAT_Pragma;
+ Ada_2005_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
-- pragma Unsuppress (IDENTIFIER [, [On =>] NAME]);
when Pragma_Unsuppress =>
- GNAT_Pragma;
+ Ada_2005_Pragma;
Process_Suppress_Unsuppress (False);
-------------------
-- pragma Wide_Character_Encoding (IDENTIFIER);
when Pragma_Wide_Character_Encoding =>
+ GNAT_Pragma;
-- Nothing to do, handled in parser. Note that we do not enforce
-- configuration pragma placement, this pragma can appear at any
projects / gcc.git / commitdiff