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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R E P C O M P --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2008, Free Software Foundation, Inc. --
-- --
-- GNAT 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Errout; use Errout;
with Lib.Writ; use Lib.Writ;
with Opt; use Opt;
with Osint; use Osint;
with Prep; use Prep;
with Scans; use Scans;
with Scn; use Scn;
with Sinput.L; use Sinput.L;
with Stringt; use Stringt;
with Table;
with Types; use Types;
package body Prepcomp is
No_Preprocessing : Boolean := True;
-- Set to False if there is at least one source that needs to be
-- preprocessed.
Source_Index_Of_Preproc_Data_File : Source_File_Index := No_Source_File;
-- The following variable should be a constant, but this is not possible
-- because its type GNAT.Dynamic_Tables.Instance has a component P of
-- unitialized private type GNAT.Dynamic_Tables.Table_Private and there are
-- no exported values for this private type.
-- Warnings are Off because it is never assigned a value.
pragma Warnings (Off);
No_Mapping : Prep.Symbol_Table.Instance;
pragma Warnings (On);
type String_Ptr is access String;
type String_Array is array (Positive range <>) of String_Ptr;
type String_Array_Ptr is access String_Array;
procedure Free is
new Ada.Unchecked_Deallocation (String_Array, String_Array_Ptr);
Symbol_Definitions : String_Array_Ptr := new String_Array (1 .. 4);
-- An extensible array to temporarily stores symbol definitions specified
-- on the command line with -gnateD switches.
Last_Definition : Natural := 0;
-- Index of last symbol definition in array Symbol_Definitions
type Preproc_Data is record
Mapping : Symbol_Table.Instance;
File_Name : File_Name_Type := No_File;
Deffile : String_Id := No_String;
Undef_False : Boolean := False;
Always_Blank : Boolean := False;
Comments : Boolean := False;
List_Symbols : Boolean := False;
Processed : Boolean := False;
end record;
-- Structure to keep the preprocessing data for a file name or for the
-- default (when Name_Id = No_Name).
No_Preproc_Data : constant Preproc_Data :=
(Mapping => No_Mapping,
File_Name => No_File,
Deffile => No_String,
Undef_False => False,
Always_Blank => False,
Comments => False,
List_Symbols => False,
Processed => False);
Default_Data : Preproc_Data := No_Preproc_Data;
-- The preprocessing data to be used when no specific preprocessing data
-- is specified for a source.
Default_Data_Defined : Boolean := False;
-- True if source for which no specific preprocessing is specified need to
-- be preprocess with the Default_Data.
Current_Data : Preproc_Data := No_Preproc_Data;
package Preproc_Data_Table is new Table.Table
(Table_Component_Type => Preproc_Data,
Table_Index_Type => Int,
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100,
Table_Name => "Prepcomp.Preproc_Data_Table");
-- Table to store the specific preprocessing data
Command_Line_Symbols : Symbol_Table.Instance;
-- A table to store symbol definitions specified on the command line with
-- -gnateD switches.
package Dependencies is new Table.Table
(Table_Component_Type => Source_File_Index,
Table_Index_Type => Int,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Prepcomp.Dependencies");
-- Table to store the dependencies on preprocessing files
procedure Add_Command_Line_Symbols;
-- Add the command line symbol definitions, if any, to Prep.Mapping table
procedure Skip_To_End_Of_Line;
-- Ignore errors and scan up to the next end of line or the end of file
------------------------------
-- Add_Command_Line_Symbols --
------------------------------
procedure Add_Command_Line_Symbols is
Symbol_Id : Prep.Symbol_Id;
begin
for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop
Symbol_Id := Prep.Index_Of (Command_Line_Symbols.Table (J).Symbol);
if Symbol_Id = No_Symbol then
Symbol_Table.Increment_Last (Prep.Mapping);
Symbol_Id := Symbol_Table.Last (Prep.Mapping);
end if;
Prep.Mapping.Table (Symbol_Id) := Command_Line_Symbols.Table (J);
end loop;
end Add_Command_Line_Symbols;
----------------------
-- Add_Dependencies --
----------------------
procedure Add_Dependencies is
begin
for Index in 1 .. Dependencies.Last loop
Add_Preprocessing_Dependency (Dependencies.Table (Index));
end loop;
end Add_Dependencies;
---------------------------
-- Add_Symbol_Definition --
---------------------------
procedure Add_Symbol_Definition (Def : String) is
begin
-- If Symbol_Definitions is not large enough, double it
if Last_Definition = Symbol_Definitions'Last then
declare
New_Symbol_Definitions : constant String_Array_Ptr :=
new String_Array (1 .. 2 * Last_Definition);
begin
New_Symbol_Definitions (Symbol_Definitions'Range) :=
Symbol_Definitions.all;
Free (Symbol_Definitions);
Symbol_Definitions := New_Symbol_Definitions;
end;
end if;
Last_Definition := Last_Definition + 1;
Symbol_Definitions (Last_Definition) := new String'(Def);
end Add_Symbol_Definition;
-------------------
-- Check_Symbols --
-------------------
procedure Check_Symbols is
begin
-- If there is at least one switch -gnateD specified
if Symbol_Table.Last (Command_Line_Symbols) >= 1 then
Current_Data := No_Preproc_Data;
No_Preprocessing := False;
Current_Data.Processed := True;
-- Start with an empty, initialized mapping table; use Prep.Mapping,
-- because Prep.Index_Of uses Prep.Mapping.
Prep.Mapping := No_Mapping;
Symbol_Table.Init (Prep.Mapping);
-- Add the command line symbols
Add_Command_Line_Symbols;
-- Put the resulting Prep.Mapping in Current_Data, and immediately
-- set Prep.Mapping to nil.
Current_Data.Mapping := Prep.Mapping;
Prep.Mapping := No_Mapping;
-- Set the default data
Default_Data := Current_Data;
Default_Data_Defined := True;
end if;
end Check_Symbols;
------------------------------
-- Parse_Preprocessing_Data --
------------------------------
procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is
OK : Boolean := False;
Dash_Location : Source_Ptr;
Symbol_Data : Prep.Symbol_Data;
Symbol_Id : Prep.Symbol_Id;
T : constant Nat := Total_Errors_Detected;
begin
-- Load the preprocessing data file
Source_Index_Of_Preproc_Data_File := Load_Preprocessing_Data_File (N);
-- Fail if preprocessing data file cannot be found
if Source_Index_Of_Preproc_Data_File = No_Source_File then
Get_Name_String (N);
Fail ("preprocessing data file """
& Name_Buffer (1 .. Name_Len)
& """ not found");
end if;
-- Initialize scanner and set its behavior for processing a data file
Scn.Scanner.Initialize_Scanner (Source_Index_Of_Preproc_Data_File);
Scn.Scanner.Set_End_Of_Line_As_Token (True);
Scn.Scanner.Reset_Special_Characters;
For_Each_Line : loop
<<Scan_Line>>
Scan;
exit For_Each_Line when Token = Tok_EOF;
if Token = Tok_End_Of_Line then
goto Scan_Line;
end if;
-- Line is not empty
OK := False;
No_Preprocessing := False;
Current_Data := No_Preproc_Data;
case Token is
when Tok_Asterisk =>
-- Default data
if Default_Data_Defined then
Error_Msg
("multiple default preprocessing data", Token_Ptr);
else
OK := True;
Default_Data_Defined := True;
end if;
when Tok_String_Literal =>
-- Specific data
String_To_Name_Buffer (String_Literal_Id);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Current_Data.File_Name := Name_Find;
OK := True;
for Index in 1 .. Preproc_Data_Table.Last loop
if Current_Data.File_Name =
Preproc_Data_Table.Table (Index).File_Name
then
Error_Msg_File_1 := Current_Data.File_Name;
Error_Msg
("multiple preprocessing data for{", Token_Ptr);
OK := False;
exit;
end if;
end loop;
when others =>
Error_Msg ("`'*` or literal string expected", Token_Ptr);
end case;
-- If there is a problem, skip the line
if not OK then
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- Scan past the * or the literal string
Scan;
-- A literal string in second position is a definition file
if Token = Tok_String_Literal then
Current_Data.Deffile := String_Literal_Id;
Current_Data.Processed := False;
Scan;
else
-- If there is no definition file, set Processed to True now
Current_Data.Processed := True;
end if;
-- Start with an empty, initialized mapping table; use Prep.Mapping,
-- because Prep.Index_Of uses Prep.Mapping.
Prep.Mapping := No_Mapping;
Symbol_Table.Init (Prep.Mapping);
-- Check the switches that may follow
while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
if Token /= Tok_Minus then
Error_Msg ("`'-` expected", Token_Ptr);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- Keep the location of the '-' for possible error reporting
Dash_Location := Token_Ptr;
-- Scan past the '-'
Scan;
OK := False;
Change_Reserved_Keyword_To_Symbol;
-- An identifier (or a reserved word converted to an
-- identifier) is expected and there must be no blank space
-- between the '-' and the identifier.
if Token = Tok_Identifier
and then Token_Ptr = Dash_Location + 1
then
Get_Name_String (Token_Name);
-- Check the character in the source, because the case is
-- significant.
case Sinput.Source (Token_Ptr) is
when 'u' =>
-- Undefined symbol are False
if Name_Len = 1 then
Current_Data.Undef_False := True;
OK := True;
end if;
when 'b' =>
-- Blank lines
if Name_Len = 1 then
Current_Data.Always_Blank := True;
OK := True;
end if;
when 'c' =>
-- Comment removed lines
if Name_Len = 1 then
Current_Data.Comments := True;
OK := True;
end if;
when 's' =>
-- List symbols
if Name_Len = 1 then
Current_Data.List_Symbols := True;
OK := True;
end if;
when 'D' =>
-- Symbol definition
OK := Name_Len > 1;
if OK then
-- A symbol must be an Ada identifier; it cannot start
-- with an underline or a digit.
if Name_Buffer (2) = '_'
or Name_Buffer (2) in '0' .. '9'
then
Error_Msg ("symbol expected", Token_Ptr + 1);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- Get the name id of the symbol
Symbol_Data.On_The_Command_Line := True;
Name_Buffer (1 .. Name_Len - 1) :=
Name_Buffer (2 .. Name_Len);
Name_Len := Name_Len - 1;
Symbol_Data.Symbol := Name_Find;
if Name_Buffer (1 .. Name_Len) = "if"
or else Name_Buffer (1 .. Name_Len) = "else"
or else Name_Buffer (1 .. Name_Len) = "elsif"
or else Name_Buffer (1 .. Name_Len) = "end"
or else Name_Buffer (1 .. Name_Len) = "not"
or else Name_Buffer (1 .. Name_Len) = "and"
or else Name_Buffer (1 .. Name_Len) = "then"
then
Error_Msg ("symbol expected", Token_Ptr + 1);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- Get the name id of the original symbol, with
-- possibly capital letters.
Name_Len := Integer (Scan_Ptr - Token_Ptr - 1);
for J in 1 .. Name_Len loop
Name_Buffer (J) :=
Sinput.Source (Token_Ptr + Text_Ptr (J));
end loop;
Symbol_Data.Original := Name_Find;
-- Scan past D<symbol>
Scan;
if Token /= Tok_Equal then
Error_Msg ("`=` expected", Token_Ptr);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- Scan past '='
Scan;
-- Here any reserved word is OK
Change_Reserved_Keyword_To_Symbol
(All_Keywords => True);
-- Value can be an identifier (or a reserved word)
-- or a literal string.
case Token is
when Tok_String_Literal =>
Symbol_Data.Is_A_String := True;
Symbol_Data.Value := String_Literal_Id;
when Tok_Identifier =>
Symbol_Data.Is_A_String := False;
Start_String;
for J in Token_Ptr .. Scan_Ptr - 1 loop
Store_String_Char (Sinput.Source (J));
end loop;
Symbol_Data.Value := End_String;
when others =>
Error_Msg
("literal string or identifier expected",
Token_Ptr);
Skip_To_End_Of_Line;
goto Scan_Line;
end case;
-- If symbol already exists, replace old definition
-- by new one.
Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol);
-- Otherwise, add a new entry in the table
if Symbol_Id = No_Symbol then
Symbol_Table.Increment_Last (Prep.Mapping);
Symbol_Id := Symbol_Table.Last (Mapping);
end if;
Prep.Mapping.Table (Symbol_Id) := Symbol_Data;
end if;
when others =>
null;
end case;
Scan;
end if;
if not OK then
Error_Msg ("invalid switch", Dash_Location);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
end loop;
-- Add the command line symbols, if any, possibly replacing symbols
-- just defined.
Add_Command_Line_Symbols;
-- Put the resulting Prep.Mapping in Current_Data, and immediately
-- set Prep.Mapping to nil.
Current_Data.Mapping := Prep.Mapping;
Prep.Mapping := No_Mapping;
-- Record Current_Data
if Current_Data.File_Name = No_File then
Default_Data := Current_Data;
else
Preproc_Data_Table.Increment_Last;
Preproc_Data_Table.Table (Preproc_Data_Table.Last) := Current_Data;
end if;
Current_Data := No_Preproc_Data;
end loop For_Each_Line;
Scn.Scanner.Set_End_Of_Line_As_Token (False);
-- Fail if there were errors in the preprocessing data file
if Total_Errors_Detected > T then
Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Fail ("errors found in preprocessing data file """
& Get_Name_String (N) & """");
end if;
-- Record the dependency on the preprocessor data file
Dependencies.Increment_Last;
Dependencies.Table (Dependencies.Last) :=
Source_Index_Of_Preproc_Data_File;
end Parse_Preprocessing_Data_File;
---------------------------
-- Prepare_To_Preprocess --
---------------------------
procedure Prepare_To_Preprocess
(Source : File_Name_Type;
Preprocessing_Needed : out Boolean)
is
Default : Boolean := False;
Index : Int := 0;
begin
-- By default, preprocessing is not needed
Preprocessing_Needed := False;
if No_Preprocessing then
return;
end if;
-- First, look for preprocessing data specific to the current source
for J in 1 .. Preproc_Data_Table.Last loop
if Preproc_Data_Table.Table (J).File_Name = Source then
Index := J;
Current_Data := Preproc_Data_Table.Table (J);
exit;
end if;
end loop;
-- If no specific preprocessing data, then take the default
if Index = 0 then
if Default_Data_Defined then
Current_Data := Default_Data;
Default := True;
else
-- If no default, then nothing to do
return;
end if;
end if;
-- Set the preprocessing flags according to the preprocessing data
if Current_Data.Comments and then not Current_Data.Always_Blank then
Comment_Deleted_Lines := True;
Blank_Deleted_Lines := False;
else
Comment_Deleted_Lines := False;
Blank_Deleted_Lines := True;
end if;
Undefined_Symbols_Are_False := Current_Data.Undef_False;
List_Preprocessing_Symbols := Current_Data.List_Symbols;
-- If not already done it, process the definition file
if Current_Data.Processed then
-- Set Prep.Mapping
Prep.Mapping := Current_Data.Mapping;
else
-- First put the mapping in Prep.Mapping, because Prep.Parse_Def_File
-- works on Prep.Mapping.
Prep.Mapping := Current_Data.Mapping;
String_To_Name_Buffer (Current_Data.Deffile);
declare
N : constant File_Name_Type := Name_Find;
Deffile : constant Source_File_Index :=
Load_Definition_File (N);
Add_Deffile : Boolean := True;
T : constant Nat := Total_Errors_Detected;
begin
if Deffile = No_Source_File then
Fail ("definition file """
& Get_Name_String (N)
& """ cannot be found");
end if;
-- Initialize the preprocessor and set the characteristics of the
-- scanner for a definition file.
Prep.Setup_Hooks
(Error_Msg => Errout.Error_Msg'Access,
Scan => Scn.Scanner.Scan'Access,
Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
Put_Char => null,
New_EOL => null);
Scn.Scanner.Set_End_Of_Line_As_Token (True);
Scn.Scanner.Reset_Special_Characters;
-- Initialize the scanner and process the definition file
Scn.Scanner.Initialize_Scanner (Deffile);
Prep.Parse_Def_File;
-- Reset the behaviour of the scanner to the default
Scn.Scanner.Set_End_Of_Line_As_Token (False);
-- Fail if errors were found while processing the definition file
if T /= Total_Errors_Detected then
Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Fail ("errors found in definition file """
& Get_Name_String (N)
& """");
end if;
for Index in 1 .. Dependencies.Last loop
if Dependencies.Table (Index) = Deffile then
Add_Deffile := False;
exit;
end if;
end loop;
if Add_Deffile then
Dependencies.Increment_Last;
Dependencies.Table (Dependencies.Last) := Deffile;
end if;
end;
-- Get back the mapping, indicate that the definition file is
-- processed and store back the preprocessing data.
Current_Data.Mapping := Prep.Mapping;
Current_Data.Processed := True;
if Default then
Default_Data := Current_Data;
else
Preproc_Data_Table.Table (Index) := Current_Data;
end if;
end if;
Preprocessing_Needed := True;
end Prepare_To_Preprocess;
---------------------------------------------
-- Process_Command_Line_Symbol_Definitions --
---------------------------------------------
procedure Process_Command_Line_Symbol_Definitions is
Symbol_Data : Prep.Symbol_Data;
Found : Boolean := False;
begin
Symbol_Table.Init (Command_Line_Symbols);
-- The command line definitions have been stored temporarily in
-- array Symbol_Definitions.
for Index in 1 .. Last_Definition loop
-- Check each symbol definition, fail immediately if syntax is not
-- correct.
Check_Command_Line_Symbol_Definition
(Definition => Symbol_Definitions (Index).all,
Data => Symbol_Data);
Found := False;
-- If there is already a definition for this symbol, replace the old
-- definition by this one.
for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop
if Command_Line_Symbols.Table (J).Symbol = Symbol_Data.Symbol then
Command_Line_Symbols.Table (J) := Symbol_Data;
Found := True;
exit;
end if;
end loop;
-- Otherwise, create a new entry in the table
if not Found then
Symbol_Table.Increment_Last (Command_Line_Symbols);
Command_Line_Symbols.Table
(Symbol_Table.Last (Command_Line_Symbols)) := Symbol_Data;
end if;
end loop;
end Process_Command_Line_Symbol_Definitions;
-------------------------
-- Skip_To_End_Of_Line --
-------------------------
procedure Skip_To_End_Of_Line is
begin
Set_Ignore_Errors (To => True);
while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
Scan;
end loop;
Set_Ignore_Errors (To => False);
end Skip_To_End_Of_Line;
end Prepcomp;
|