forked from Lainports/opnsense-ports
302 lines
11 KiB
Text
302 lines
11 KiB
Text
These restriction pragmas are not yet supported on FSF GNAT 5:
|
|
No_Specification_Of_Aspect
|
|
No_Use_Of_Attribute
|
|
No_Use_Of_Pragma
|
|
|
|
--- gnat/targparm.ads.orig 2015-05-06 11:08:38 UTC
|
|
+++ gnat/targparm.ads
|
|
@@ -615,53 +615,28 @@ package Targparm is
|
|
-- selected component with Sloc value System_Location and given Prefix
|
|
-- (Pre) and Selector (Sel) values.
|
|
|
|
- type Set_NOD_Type is access procedure (Unit : Node_Id);
|
|
+ type Set_RND_Type is access procedure (Unit : Node_Id);
|
|
-- Parameter type for Get_Target_Parameters that records a Restriction
|
|
-- No_Dependence for the given unit (identifier or selected component).
|
|
|
|
- type Set_NSA_Type is access procedure (Asp : Name_Id; OK : out Boolean);
|
|
- -- Parameter type for Get_Target_Parameters that records a Restriction
|
|
- -- No_Specification_Of_Aspect. Asp is the aspect name. OK is set True
|
|
- -- if this is an OK aspect name, and False if it is not an aspect name.
|
|
-
|
|
- type Set_NUA_Type is access procedure (Attr : Name_Id; OK : out Boolean);
|
|
- -- Parameter type for Get_Target_Parameters that records a Restriction
|
|
- -- No_Use_Of_Attribute. Attr is the attribute name. OK is set True if
|
|
- -- this is an OK attribute name, and False if it is not an attribute name.
|
|
-
|
|
- type Set_NUP_Type is access procedure (Prag : Name_Id; OK : out Boolean);
|
|
- -- Parameter type for Get_Target_Parameters that records a Restriction
|
|
- -- No_Use_Of_Pragma. Prag is the pragma name. OK is set True if this is
|
|
- -- an OK pragma name, and False if it is not a recognized pragma name.
|
|
-
|
|
procedure Get_Target_Parameters
|
|
(System_Text : Source_Buffer_Ptr;
|
|
Source_First : Source_Ptr;
|
|
Source_Last : Source_Ptr;
|
|
Make_Id : Make_Id_Type := null;
|
|
Make_SC : Make_SC_Type := null;
|
|
- Set_NOD : Set_NOD_Type := null;
|
|
- Set_NSA : Set_NSA_Type := null;
|
|
- Set_NUA : Set_NUA_Type := null;
|
|
- Set_NUP : Set_NUP_Type := null);
|
|
- -- Called at the start of execution to obtain target parameters from the
|
|
- -- source of package System. The parameters provide the source text to be
|
|
- -- scanned (in System_Text (Source_First .. Source_Last)). If the three
|
|
- -- subprograms Make_Id, Make_SC, and Set_NOD are left at their default
|
|
- -- value of null, Get_Target_Parameters will ignore pragma Restrictions
|
|
- -- (No_Dependence) lines; otherwise it will use these three subprograms to
|
|
- -- record them. Similarly, if Set_NUP is left at its default value of null,
|
|
- -- then any occurrences of pragma Restrictions (No_Use_Of_Pragma => XXX)
|
|
- -- will be ignored; otherwise it will use this procedure to record the
|
|
- -- pragma. Similarly for the NSA and NUA cases.
|
|
+ Set_RND : Set_RND_Type := null);
|
|
+ -- Called at the start of execution to obtain target parameters from
|
|
+ -- the source of package System. The parameters provide the source
|
|
+ -- text to be scanned (in System_Text (Source_First .. Source_Last)).
|
|
+ -- if the three subprograms are left at their default value of null,
|
|
+ -- Get_Target_Parameters will ignore pragma Restrictions No_Dependence
|
|
+ -- lines, otherwise it will use these three subprograms to record them.
|
|
|
|
procedure Get_Target_Parameters
|
|
(Make_Id : Make_Id_Type := null;
|
|
Make_SC : Make_SC_Type := null;
|
|
- Set_NOD : Set_NOD_Type := null;
|
|
- Set_NSA : Set_NSA_Type := null;
|
|
- Set_NUA : Set_NUA_Type := null;
|
|
- Set_NUP : Set_NUP_Type := null);
|
|
+ Set_RND : Set_RND_Type := null);
|
|
-- This version reads in system.ads using Osint. The idea is that the
|
|
-- caller uses the first version if they have to read system.ads anyway
|
|
-- (e.g. the compiler) and uses this simpler interface if system.ads is
|
|
--- gnat/targparm.adb.orig 2015-05-06 11:08:38 UTC
|
|
+++ gnat/targparm.adb
|
|
@@ -154,10 +154,7 @@ package body Targparm is
|
|
procedure Get_Target_Parameters
|
|
(Make_Id : Make_Id_Type := null;
|
|
Make_SC : Make_SC_Type := null;
|
|
- Set_NOD : Set_NOD_Type := null;
|
|
- Set_NSA : Set_NSA_Type := null;
|
|
- Set_NUA : Set_NUA_Type := null;
|
|
- Set_NUP : Set_NUP_Type := null)
|
|
+ Set_RND : Set_RND_Type := null)
|
|
is
|
|
Text : Source_Buffer_Ptr;
|
|
Hi : Source_Ptr;
|
|
@@ -184,10 +181,7 @@ package body Targparm is
|
|
Source_Last => Hi,
|
|
Make_Id => Make_Id,
|
|
Make_SC => Make_SC,
|
|
- Set_NOD => Set_NOD,
|
|
- Set_NSA => Set_NSA,
|
|
- Set_NUA => Set_NUA,
|
|
- Set_NUP => Set_NUP);
|
|
+ Set_RND => Set_RND);
|
|
end Get_Target_Parameters;
|
|
|
|
-- Version where caller supplies system.ads text
|
|
@@ -198,10 +192,7 @@ package body Targparm is
|
|
Source_Last : Source_Ptr;
|
|
Make_Id : Make_Id_Type := null;
|
|
Make_SC : Make_SC_Type := null;
|
|
- Set_NOD : Set_NOD_Type := null;
|
|
- Set_NSA : Set_NSA_Type := null;
|
|
- Set_NUA : Set_NUA_Type := null;
|
|
- Set_NUP : Set_NUP_Type := null)
|
|
+ Set_RND : Set_RND_Type := null)
|
|
is
|
|
P : Source_Ptr;
|
|
-- Scans source buffer containing source of system.ads
|
|
@@ -212,48 +203,6 @@ package body Targparm is
|
|
Result : Boolean;
|
|
-- Records boolean from system line
|
|
|
|
- OK : Boolean;
|
|
- -- Status result from Set_NUP/NSA/NUA call
|
|
-
|
|
- PR_Start : Source_Ptr;
|
|
- -- Pointer to ( following pragma Restrictions
|
|
-
|
|
- procedure Collect_Name;
|
|
- -- Scan a name starting at System_Text (P), and put Name in Name_Buffer,
|
|
- -- with Name_Len being length, folded to lower case. On return, P points
|
|
- -- just past the last character (which should be a right paren).
|
|
-
|
|
- ------------------
|
|
- -- Collect_Name --
|
|
- ------------------
|
|
-
|
|
- procedure Collect_Name is
|
|
- begin
|
|
- Name_Len := 0;
|
|
- loop
|
|
- if System_Text (P) in 'a' .. 'z'
|
|
- or else
|
|
- System_Text (P) = '_'
|
|
- or else
|
|
- System_Text (P) in '0' .. '9'
|
|
- then
|
|
- Name_Buffer (Name_Len + 1) := System_Text (P);
|
|
-
|
|
- elsif System_Text (P) in 'A' .. 'Z' then
|
|
- Name_Buffer (Name_Len + 1) :=
|
|
- Character'Val (Character'Pos (System_Text (P)) + 32);
|
|
-
|
|
- else
|
|
- exit;
|
|
- end if;
|
|
-
|
|
- P := P + 1;
|
|
- Name_Len := Name_Len + 1;
|
|
- end loop;
|
|
- end Collect_Name;
|
|
-
|
|
- -- Start of processing for Get_Target_Parameters
|
|
-
|
|
begin
|
|
if Parameters_Obtained then
|
|
return;
|
|
@@ -312,9 +261,6 @@ package body Targparm is
|
|
|
|
elsif System_Text (P .. P + 20) = "pragma Restrictions (" then
|
|
P := P + 21;
|
|
- PR_Start := P - 1;
|
|
-
|
|
- -- Boolean restrictions
|
|
|
|
Rloop : for K in All_Boolean_Restrictions loop
|
|
declare
|
|
@@ -339,9 +285,7 @@ package body Targparm is
|
|
null;
|
|
end loop Rloop;
|
|
|
|
- -- Restrictions taking integer parameter
|
|
-
|
|
- Ploop : for K in Integer_Parameter_Restrictions loop
|
|
+ Ploop : for K in All_Parameter_Restrictions loop
|
|
declare
|
|
Rname : constant String :=
|
|
All_Parameter_Restrictions'Image (K);
|
|
@@ -456,119 +400,23 @@ package body Targparm is
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
- Set_NOD (Unit);
|
|
+ Set_RND (Unit);
|
|
goto Line_Loop_Continue;
|
|
end;
|
|
-
|
|
- -- No_Specification_Of_Aspect case
|
|
-
|
|
- elsif System_Text (P .. P + 29) = "No_Specification_Of_Aspect => "
|
|
- then
|
|
- P := P + 30;
|
|
-
|
|
- -- Skip this processing (and simply ignore the pragma), if
|
|
- -- caller did not supply the subprogram we need to process
|
|
- -- such lines.
|
|
-
|
|
- if Set_NSA = null then
|
|
- goto Line_Loop_Continue;
|
|
- end if;
|
|
-
|
|
- -- We have scanned
|
|
- -- "pragma Restrictions (No_Specification_Of_Aspect =>"
|
|
-
|
|
- Collect_Name;
|
|
-
|
|
- if System_Text (P) /= ')' then
|
|
- goto Bad_Restrictions_Pragma;
|
|
-
|
|
- else
|
|
- Set_NSA (Name_Find, OK);
|
|
-
|
|
- if OK then
|
|
- goto Line_Loop_Continue;
|
|
- else
|
|
- goto Bad_Restrictions_Pragma;
|
|
- end if;
|
|
- end if;
|
|
-
|
|
- -- No_Use_Of_Attribute case
|
|
-
|
|
- elsif System_Text (P .. P + 22) = "No_Use_Of_Attribute => " then
|
|
- P := P + 23;
|
|
-
|
|
- -- Skip this processing (and simply ignore No_Use_Of_Attribute
|
|
- -- lines) if caller did not supply the subprogram we need to
|
|
- -- process such lines.
|
|
-
|
|
- if Set_NUA = null then
|
|
- goto Line_Loop_Continue;
|
|
- end if;
|
|
-
|
|
- -- We have scanned
|
|
- -- "pragma Restrictions (No_Use_Of_Attribute =>"
|
|
-
|
|
- Collect_Name;
|
|
-
|
|
- if System_Text (P) /= ')' then
|
|
- goto Bad_Restrictions_Pragma;
|
|
-
|
|
- else
|
|
- Set_NUA (Name_Find, OK);
|
|
-
|
|
- if OK then
|
|
- goto Line_Loop_Continue;
|
|
- else
|
|
- goto Bad_Restrictions_Pragma;
|
|
- end if;
|
|
- end if;
|
|
-
|
|
- -- No_Use_Of_Pragma case
|
|
-
|
|
- elsif System_Text (P .. P + 19) = "No_Use_Of_Pragma => " then
|
|
- P := P + 20;
|
|
-
|
|
- -- Skip this processing (and simply ignore No_Use_Of_Pragma
|
|
- -- lines) if caller did not supply the subprogram we need to
|
|
- -- process such lines.
|
|
-
|
|
- if Set_NUP = null then
|
|
- goto Line_Loop_Continue;
|
|
- end if;
|
|
-
|
|
- -- We have scanned
|
|
- -- "pragma Restrictions (No_Use_Of_Pragma =>"
|
|
-
|
|
- Collect_Name;
|
|
-
|
|
- if System_Text (P) /= ')' then
|
|
- goto Bad_Restrictions_Pragma;
|
|
-
|
|
- else
|
|
- Set_NUP (Name_Find, OK);
|
|
-
|
|
- if OK then
|
|
- goto Line_Loop_Continue;
|
|
- else
|
|
- goto Bad_Restrictions_Pragma;
|
|
- end if;
|
|
- end if;
|
|
end if;
|
|
|
|
-- Here if unrecognizable restrictions pragma form
|
|
|
|
- <<Bad_Restrictions_Pragma>>
|
|
-
|
|
Set_Standard_Error;
|
|
Write_Line
|
|
("fatal error: system.ads is incorrectly formatted");
|
|
Write_Str ("unrecognized or incorrect restrictions pragma: ");
|
|
|
|
- P := PR_Start;
|
|
+ while System_Text (P) /= ')'
|
|
+ and then
|
|
+ System_Text (P) /= ASCII.LF
|
|
loop
|
|
- exit when System_Text (P) = ASCII.LF;
|
|
Write_Char (System_Text (P));
|
|
- exit when System_Text (P) = ')';
|
|
P := P + 1;
|
|
end loop;
|
|
|