1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
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;
|