OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [sinput-l.adb] - Blame information for rev 281

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             S I N P U T . L                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Alloc;
27
with Atree;    use Atree;
28
with Debug;    use Debug;
29
with Einfo;    use Einfo;
30
with Errout;   use Errout;
31
with Fname;    use Fname;
32
with Hostparm;
33
with Opt;      use Opt;
34
with Osint;    use Osint;
35
with Output;   use Output;
36
with Prep;     use Prep;
37
with Prepcomp; use Prepcomp;
38
with Scans;    use Scans;
39
with Scn;      use Scn;
40
with Sinfo;    use Sinfo;
41
with Snames;   use Snames;
42
with System;   use System;
43
 
44
with System.OS_Lib; use System.OS_Lib;
45
 
46
with Unchecked_Conversion;
47
 
48
package body Sinput.L is
49
 
50
   Prep_Buffer : Text_Buffer_Ptr := null;
51
   --  A buffer to temporarily stored the result of preprocessing a source.
52
   --  It is only allocated if there is at least one source to preprocess.
53
 
54
   Prep_Buffer_Last : Text_Ptr := 0;
55
   --  Index of the last significant character in Prep_Buffer
56
 
57
   Initial_Size_Of_Prep_Buffer : constant := 10_000;
58
   --  Size of Prep_Buffer when it is first allocated
59
 
60
   --  When a file is to be preprocessed and the options to list symbols
61
   --  has been selected (switch -s), Prep.List_Symbols is called with a
62
   --  "foreword", a single line indicating what source the symbols apply to.
63
   --  The following two constant String are the start and the end of this
64
   --  foreword.
65
 
66
   Foreword_Start : constant String :=
67
                      "Preprocessing Symbols for source """;
68
 
69
   Foreword_End : constant String := """";
70
 
71
   -----------------
72
   -- Subprograms --
73
   -----------------
74
 
75
   procedure Put_Char_In_Prep_Buffer (C : Character);
76
   --  Add one character in Prep_Buffer, extending Prep_Buffer if need be.
77
   --  Used to initialize the preprocessor.
78
 
79
   procedure New_EOL_In_Prep_Buffer;
80
   --  Add an LF to Prep_Buffer (used to initialize the preprocessor)
81
 
82
   function Load_File
83
     (N : File_Name_Type;
84
      T : Osint.File_Type) return Source_File_Index;
85
   --  Load a source file, a configuration pragmas file or a definition file
86
   --  Coding also allows preprocessing file, but not a library file ???
87
 
88
   -------------------------------
89
   -- Adjust_Instantiation_Sloc --
90
   -------------------------------
91
 
92
   procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
93
      Loc : constant Source_Ptr := Sloc (N);
94
 
95
   begin
96
      --  We only do the adjustment if the value is between the appropriate low
97
      --  and high values. It is not clear that this should ever not be the
98
      --  case, but in practice there seem to be some nodes that get copied
99
      --  twice, and this is a defence against that happening.
100
 
101
      if A.Lo <= Loc and then Loc <= A.Hi then
102
         Set_Sloc (N, Loc + A.Adjust);
103
      end if;
104
   end Adjust_Instantiation_Sloc;
105
 
106
   --------------------------------
107
   -- Complete_Source_File_Entry --
108
   --------------------------------
109
 
110
   procedure Complete_Source_File_Entry is
111
      CSF : constant Source_File_Index := Current_Source_File;
112
 
113
   begin
114
      Trim_Lines_Table (CSF);
115
      Source_File.Table (CSF).Source_Checksum := Checksum;
116
   end Complete_Source_File_Entry;
117
 
118
   ---------------------------------
119
   -- Create_Instantiation_Source --
120
   ---------------------------------
121
 
122
   procedure Create_Instantiation_Source
123
     (Inst_Node    : Entity_Id;
124
      Template_Id  : Entity_Id;
125
      Inlined_Body : Boolean;
126
      A            : out Sloc_Adjustment)
127
   is
128
      Dnod : constant Node_Id := Declaration_Node (Template_Id);
129
      Xold : Source_File_Index;
130
      Xnew : Source_File_Index;
131
 
132
   begin
133
      Xold := Get_Source_File_Index (Sloc (Template_Id));
134
      A.Lo := Source_File.Table (Xold).Source_First;
135
      A.Hi := Source_File.Table (Xold).Source_Last;
136
 
137
      Source_File.Append (Source_File.Table (Xold));
138
      Xnew := Source_File.Last;
139
 
140
      Source_File.Table (Xnew).Inlined_Body  := Inlined_Body;
141
      Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
142
      Source_File.Table (Xnew).Template      := Xold;
143
 
144
      --  Now we need to compute the new values of Source_First, Source_Last
145
      --  and adjust the source file pointer to have the correct virtual
146
      --  origin for the new range of values.
147
 
148
      Source_File.Table (Xnew).Source_First :=
149
        Source_File.Table (Xnew - 1).Source_Last + 1;
150
      A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
151
      Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
152
 
153
      Set_Source_File_Index_Table (Xnew);
154
 
155
      Source_File.Table (Xnew).Sloc_Adjust :=
156
        Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
157
 
158
      if Debug_Flag_L then
159
         Write_Eol;
160
         Write_Str ("*** Create instantiation source for ");
161
 
162
         if Nkind (Dnod) in N_Proper_Body
163
           and then Was_Originally_Stub (Dnod)
164
         then
165
            Write_Str ("subunit ");
166
 
167
         elsif Ekind (Template_Id) = E_Generic_Package then
168
            if Nkind (Dnod) = N_Package_Body then
169
               Write_Str ("body of package ");
170
            else
171
               Write_Str ("spec of package ");
172
            end if;
173
 
174
         elsif Ekind (Template_Id) = E_Function then
175
            Write_Str ("body of function ");
176
 
177
         elsif Ekind (Template_Id) = E_Procedure then
178
            Write_Str ("body of procedure ");
179
 
180
         elsif Ekind (Template_Id) = E_Generic_Function then
181
            Write_Str ("spec of function ");
182
 
183
         elsif Ekind (Template_Id) = E_Generic_Procedure then
184
            Write_Str ("spec of procedure ");
185
 
186
         elsif Ekind (Template_Id) = E_Package_Body then
187
            Write_Str ("body of package ");
188
 
189
         else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
190
 
191
            if Nkind (Dnod) = N_Procedure_Specification then
192
               Write_Str ("body of procedure ");
193
            else
194
               Write_Str ("body of function ");
195
            end if;
196
         end if;
197
 
198
         Write_Name (Chars (Template_Id));
199
         Write_Eol;
200
 
201
         Write_Str ("  new source index = ");
202
         Write_Int (Int (Xnew));
203
         Write_Eol;
204
 
205
         Write_Str ("  copying from file name = ");
206
         Write_Name (File_Name (Xold));
207
         Write_Eol;
208
 
209
         Write_Str ("  old source index = ");
210
         Write_Int (Int (Xold));
211
         Write_Eol;
212
 
213
         Write_Str ("  old lo = ");
214
         Write_Int (Int (A.Lo));
215
         Write_Eol;
216
 
217
         Write_Str ("  old hi = ");
218
         Write_Int (Int (A.Hi));
219
         Write_Eol;
220
 
221
         Write_Str ("  new lo = ");
222
         Write_Int (Int (Source_File.Table (Xnew).Source_First));
223
         Write_Eol;
224
 
225
         Write_Str ("  new hi = ");
226
         Write_Int (Int (Source_File.Table (Xnew).Source_Last));
227
         Write_Eol;
228
 
229
         Write_Str ("  adjustment factor = ");
230
         Write_Int (Int (A.Adjust));
231
         Write_Eol;
232
 
233
         Write_Str ("  instantiation location: ");
234
         Write_Location (Sloc (Inst_Node));
235
         Write_Eol;
236
      end if;
237
 
238
      --  For a given character in the source, a higher subscript will be used
239
      --  to access the instantiation, which means that the virtual origin must
240
      --  have a corresponding lower value. We compute this new origin by
241
      --  taking the address of the appropriate adjusted element in the old
242
      --  array. Since this adjusted element will be at a negative subscript,
243
      --  we must suppress checks.
244
 
245
      declare
246
         pragma Suppress (All_Checks);
247
 
248
         pragma Warnings (Off);
249
         --  This unchecked conversion is aliasing safe, since it is never used
250
         --  to create improperly aliased pointer values.
251
 
252
         function To_Source_Buffer_Ptr is new
253
           Unchecked_Conversion (Address, Source_Buffer_Ptr);
254
 
255
         pragma Warnings (On);
256
 
257
      begin
258
         Source_File.Table (Xnew).Source_Text :=
259
           To_Source_Buffer_Ptr
260
             (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
261
      end;
262
   end Create_Instantiation_Source;
263
 
264
   ----------------------
265
   -- Load_Config_File --
266
   ----------------------
267
 
268
   function Load_Config_File
269
     (N : File_Name_Type) return Source_File_Index
270
   is
271
   begin
272
      return Load_File (N, Osint.Config);
273
   end Load_Config_File;
274
 
275
   --------------------------
276
   -- Load_Definition_File --
277
   --------------------------
278
 
279
   function Load_Definition_File
280
     (N : File_Name_Type) return Source_File_Index
281
   is
282
   begin
283
      return Load_File (N, Osint.Definition);
284
   end Load_Definition_File;
285
 
286
   ---------------
287
   -- Load_File --
288
   ---------------
289
 
290
   function Load_File
291
     (N : File_Name_Type;
292
      T : Osint.File_Type) return Source_File_Index
293
   is
294
      Src : Source_Buffer_Ptr;
295
      X   : Source_File_Index;
296
      Lo  : Source_Ptr;
297
      Hi  : Source_Ptr;
298
 
299
      Preprocessing_Needed : Boolean := False;
300
 
301
   begin
302
      --  If already there, don't need to reload file. An exception occurs
303
      --  in multiple unit per file mode. It would be nice in this case to
304
      --  share the same source file for each unit, but this leads to many
305
      --  difficulties with assumptions (e.g. in the body of lib), that a
306
      --  unit can be found by locating its source file index. Since we do
307
      --  not expect much use of this mode, it's no big deal to waste a bit
308
      --  of space and time by reading and storing the source multiple times.
309
 
310
      if Multiple_Unit_Index = 0 then
311
         for J in 1 .. Source_File.Last loop
312
            if Source_File.Table (J).File_Name = N then
313
               return J;
314
            end if;
315
         end loop;
316
      end if;
317
 
318
      --  Here we must build a new entry in the file table
319
 
320
      --  But first, we must check if a source needs to be preprocessed,
321
      --  because we may have to load and parse a definition file, and we want
322
      --  to do that before we load the source, so that the buffer of the
323
      --  source will be the last created, and we will be able to replace it
324
      --  and modify Hi without stepping on another buffer.
325
 
326
      if T = Osint.Source and then not Is_Internal_File_Name (N) then
327
         Prepare_To_Preprocess
328
           (Source => N, Preprocessing_Needed => Preprocessing_Needed);
329
      end if;
330
 
331
      Source_File.Increment_Last;
332
      X := Source_File.Last;
333
 
334
      if X = Source_File.First then
335
         Lo := First_Source_Ptr;
336
      else
337
         Lo := Source_File.Table (X - 1).Source_Last + 1;
338
      end if;
339
 
340
      Osint.Read_Source_File (N, Lo, Hi, Src, T);
341
 
342
      if Src = null then
343
         Source_File.Decrement_Last;
344
         return No_Source_File;
345
 
346
      else
347
         if Debug_Flag_L then
348
            Write_Eol;
349
            Write_Str ("*** Build source file table entry, Index = ");
350
            Write_Int (Int (X));
351
            Write_Str (", file name = ");
352
            Write_Name (N);
353
            Write_Eol;
354
            Write_Str ("  lo = ");
355
            Write_Int (Int (Lo));
356
            Write_Eol;
357
            Write_Str ("  hi = ");
358
            Write_Int (Int (Hi));
359
            Write_Eol;
360
 
361
            Write_Str ("  first 10 chars -->");
362
 
363
            declare
364
               procedure Wchar (C : Character);
365
               --  Writes character or ? for control character
366
 
367
               -----------
368
               -- Wchar --
369
               -----------
370
 
371
               procedure Wchar (C : Character) is
372
               begin
373
                  if C < ' '
374
                    or else C in ASCII.DEL .. Character'Val (16#9F#)
375
                  then
376
                     Write_Char ('?');
377
                  else
378
                     Write_Char (C);
379
                  end if;
380
               end Wchar;
381
 
382
            begin
383
               for J in Lo .. Lo + 9 loop
384
                  Wchar (Src (J));
385
               end loop;
386
 
387
               Write_Str ("<--");
388
               Write_Eol;
389
 
390
               Write_Str ("  last 10 chars  -->");
391
 
392
               for J in Hi - 10 .. Hi - 1 loop
393
                  Wchar (Src (J));
394
               end loop;
395
 
396
               Write_Str ("<--");
397
               Write_Eol;
398
 
399
               if Src (Hi) /= EOF then
400
                  Write_Str ("  error: no EOF at end");
401
                  Write_Eol;
402
               end if;
403
            end;
404
         end if;
405
 
406
         declare
407
            S         : Source_File_Record renames Source_File.Table (X);
408
            File_Type : Type_Of_File;
409
 
410
         begin
411
            case T is
412
               when Osint.Source =>
413
                  File_Type := Sinput.Src;
414
 
415
               when Osint.Library =>
416
                  raise Program_Error;
417
 
418
               when Osint.Config =>
419
                  File_Type := Sinput.Config;
420
 
421
               when Osint.Definition =>
422
                  File_Type := Def;
423
 
424
               when Osint.Preprocessing_Data =>
425
                  File_Type := Preproc;
426
            end case;
427
 
428
            S := (Debug_Source_Name   => N,
429
                  File_Name           => N,
430
                  File_Type           => File_Type,
431
                  First_Mapped_Line   => No_Line_Number,
432
                  Full_Debug_Name     => Osint.Full_Source_Name,
433
                  Full_File_Name      => Osint.Full_Source_Name,
434
                  Full_Ref_Name       => Osint.Full_Source_Name,
435
                  Identifier_Casing   => Unknown,
436
                  Inlined_Body        => False,
437
                  Instantiation       => No_Location,
438
                  Keyword_Casing      => Unknown,
439
                  Last_Source_Line    => 1,
440
                  License             => Unknown,
441
                  Lines_Table         => null,
442
                  Lines_Table_Max     => 1,
443
                  Logical_Lines_Table => null,
444
                  Num_SRef_Pragmas    => 0,
445
                  Reference_Name      => N,
446
                  Sloc_Adjust         => 0,
447
                  Source_Checksum     => 0,
448
                  Source_First        => Lo,
449
                  Source_Last         => Hi,
450
                  Source_Text         => Src,
451
                  Template            => No_Source_File,
452
                  Unit                => No_Unit,
453
                  Time_Stamp          => Osint.Current_Source_File_Stamp);
454
 
455
            Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
456
            S.Lines_Table (1) := Lo;
457
         end;
458
 
459
         --  Preprocess the source if it needs to be preprocessed
460
 
461
         if Preprocessing_Needed then
462
 
463
            --  Temporarily set the Source_File_Index_Table entries for the
464
            --  source, to avoid crash when reporting an error.
465
 
466
            Set_Source_File_Index_Table (X);
467
 
468
            if Opt.List_Preprocessing_Symbols then
469
               Get_Name_String (N);
470
 
471
               declare
472
                  Foreword : String (1 .. Foreword_Start'Length +
473
                                          Name_Len + Foreword_End'Length);
474
 
475
               begin
476
                  Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
477
                  Foreword (Foreword_Start'Length + 1 ..
478
                              Foreword_Start'Length + Name_Len) :=
479
                    Name_Buffer (1 .. Name_Len);
480
                  Foreword (Foreword'Last - Foreword_End'Length + 1 ..
481
                              Foreword'Last) := Foreword_End;
482
                  Prep.List_Symbols (Foreword);
483
               end;
484
            end if;
485
 
486
            declare
487
               T : constant Nat := Total_Errors_Detected;
488
               --  Used to check if there were errors during preprocessing
489
 
490
               Save_Style_Check : Boolean;
491
               --  Saved state of the Style_Check flag (which needs to be
492
               --  temporarily set to False during preprocessing, see below).
493
 
494
               Modified : Boolean;
495
 
496
            begin
497
               --  If this is the first time we preprocess a source, allocate
498
               --  the preprocessing buffer.
499
 
500
               if Prep_Buffer = null then
501
                  Prep_Buffer :=
502
                    new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
503
               end if;
504
 
505
               --  Make sure the preprocessing buffer is empty
506
 
507
               Prep_Buffer_Last := 0;
508
 
509
               --  Initialize the preprocessor hooks
510
 
511
               Prep.Setup_Hooks
512
                 (Error_Msg         => Errout.Error_Msg'Access,
513
                  Scan              => Scn.Scanner.Scan'Access,
514
                  Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
515
                  Put_Char          => Put_Char_In_Prep_Buffer'Access,
516
                  New_EOL           => New_EOL_In_Prep_Buffer'Access);
517
 
518
               --  Initialize scanner and set its behavior for preprocessing,
519
               --  then preprocess. Also disable style checks, since some of
520
               --  them are done in the scanner (specifically, those dealing
521
               --  with line length and line termination), and cannot be done
522
               --  during preprocessing (because the source file index table
523
               --  has not been set yet).
524
 
525
               Scn.Scanner.Initialize_Scanner (X);
526
 
527
               Scn.Scanner.Set_Special_Character ('#');
528
               Scn.Scanner.Set_Special_Character ('$');
529
               Scn.Scanner.Set_End_Of_Line_As_Token (True);
530
               Save_Style_Check := Opt.Style_Check;
531
               Opt.Style_Check := False;
532
 
533
               --  Make sure that there will be no check of pragma Restrictions
534
               --  for obsolescent features while preprocessing the source.
535
 
536
               Scn.Set_Obsolescent_Check (False);
537
               Preprocess (Modified);
538
               Scn.Set_Obsolescent_Check (True);
539
 
540
               --  Reset the scanner to its standard behavior, and restore the
541
               --  Style_Checks flag.
542
 
543
               Scn.Scanner.Reset_Special_Characters;
544
               Scn.Scanner.Set_End_Of_Line_As_Token (False);
545
               Opt.Style_Check := Save_Style_Check;
546
 
547
               --  If there were errors during preprocessing, record an error
548
               --  at the start of the file, and do not change the source
549
               --  buffer.
550
 
551
               if T /= Total_Errors_Detected then
552
                  Errout.Error_Msg
553
                    ("file could not be successfully preprocessed", Lo);
554
                  return No_Source_File;
555
 
556
               else
557
                  --  Output the result of the preprocessing, if requested and
558
                  --  the source has been modified by the preprocessing.
559
 
560
                  if Generate_Processed_File and then Modified then
561
                     declare
562
                        FD     : File_Descriptor;
563
                        NB     : Integer;
564
                        Status : Boolean;
565
 
566
                     begin
567
                        Get_Name_String (N);
568
 
569
                        if Hostparm.OpenVMS then
570
                           Add_Str_To_Name_Buffer ("_prep");
571
                        else
572
                           Add_Str_To_Name_Buffer (".prep");
573
                        end if;
574
 
575
                        Delete_File (Name_Buffer (1 .. Name_Len), Status);
576
 
577
                        FD :=
578
                          Create_New_File (Name_Buffer (1 .. Name_Len), Text);
579
 
580
                        Status := FD /= Invalid_FD;
581
 
582
                        if Status then
583
                           NB :=
584
                             Write
585
                               (FD,
586
                                Prep_Buffer (1)'Address,
587
                                Integer (Prep_Buffer_Last));
588
                           Status := NB = Integer (Prep_Buffer_Last);
589
                        end if;
590
 
591
                        if Status then
592
                           Close (FD, Status);
593
                        end if;
594
 
595
                        if not Status then
596
                           Errout.Error_Msg
597
                             ("could not write processed file """ &
598
                              Name_Buffer (1 .. Name_Len) & '"',
599
                              Lo);
600
                           return No_Source_File;
601
                        end if;
602
                     end;
603
                  end if;
604
 
605
                  --  Set the new value of Hi
606
 
607
                  Hi := Lo + Source_Ptr (Prep_Buffer_Last);
608
 
609
                  --  Create the new source buffer
610
 
611
                  declare
612
                     subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
613
                     --  Physical buffer allocated
614
 
615
                     type Actual_Source_Ptr is access Actual_Source_Buffer;
616
                     --  Pointer type for the physical buffer allocated
617
 
618
                     Actual_Ptr : constant Actual_Source_Ptr :=
619
                                    new Actual_Source_Buffer;
620
                     --  Actual physical buffer
621
 
622
                  begin
623
                     Actual_Ptr (Lo .. Hi - 1) :=
624
                       Prep_Buffer (1 .. Prep_Buffer_Last);
625
                     Actual_Ptr (Hi) := EOF;
626
 
627
                     --  Now we need to work out the proper virtual origin
628
                     --  pointer to return. This is Actual_Ptr (0)'Address, but
629
                     --  we have to be careful to suppress checks to compute
630
                     --  this address.
631
 
632
                     declare
633
                        pragma Suppress (All_Checks);
634
 
635
                        pragma Warnings (Off);
636
                        --  This unchecked conversion is aliasing safe, since
637
                        --  it is never used to create improperly aliased
638
                        --  pointer values.
639
 
640
                        function To_Source_Buffer_Ptr is new
641
                          Unchecked_Conversion (Address, Source_Buffer_Ptr);
642
 
643
                        pragma Warnings (On);
644
 
645
                     begin
646
                        Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
647
 
648
                        --  Record in the table the new source buffer and the
649
                        --  new value of Hi.
650
 
651
                        Source_File.Table (X).Source_Text := Src;
652
                        Source_File.Table (X).Source_Last := Hi;
653
 
654
                        --  Reset Last_Line to 1, because the lines do not
655
                        --  have necessarily the same starts and lengths.
656
 
657
                        Source_File.Table (X).Last_Source_Line := 1;
658
                     end;
659
                  end;
660
               end if;
661
            end;
662
         end if;
663
 
664
         Set_Source_File_Index_Table (X);
665
         return X;
666
      end if;
667
   end Load_File;
668
 
669
   ----------------------------------
670
   -- Load_Preprocessing_Data_File --
671
   ----------------------------------
672
 
673
   function Load_Preprocessing_Data_File
674
     (N : File_Name_Type) return Source_File_Index
675
   is
676
   begin
677
      return Load_File (N, Osint.Preprocessing_Data);
678
   end Load_Preprocessing_Data_File;
679
 
680
   ----------------------
681
   -- Load_Source_File --
682
   ----------------------
683
 
684
   function Load_Source_File
685
     (N : File_Name_Type) return Source_File_Index
686
   is
687
   begin
688
      return Load_File (N, Osint.Source);
689
   end Load_Source_File;
690
 
691
   ----------------------------
692
   -- New_EOL_In_Prep_Buffer --
693
   ----------------------------
694
 
695
   procedure New_EOL_In_Prep_Buffer is
696
   begin
697
      Put_Char_In_Prep_Buffer (ASCII.LF);
698
   end New_EOL_In_Prep_Buffer;
699
 
700
   -----------------------------
701
   -- Put_Char_In_Prep_Buffer --
702
   -----------------------------
703
 
704
   procedure Put_Char_In_Prep_Buffer (C : Character) is
705
   begin
706
      --  If preprocessing buffer is not large enough, double it
707
 
708
      if Prep_Buffer_Last = Prep_Buffer'Last then
709
         declare
710
            New_Prep_Buffer : constant Text_Buffer_Ptr :=
711
              new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
712
 
713
         begin
714
            New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
715
            Free (Prep_Buffer);
716
            Prep_Buffer := New_Prep_Buffer;
717
         end;
718
      end if;
719
 
720
      Prep_Buffer_Last := Prep_Buffer_Last + 1;
721
      Prep_Buffer (Prep_Buffer_Last) := C;
722
   end Put_Char_In_Prep_Buffer;
723
 
724
   -----------------------------------
725
   -- Source_File_Is_Pragma_No_Body --
726
   -----------------------------------
727
 
728
   function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
729
   begin
730
      Initialize_Scanner (No_Unit, X);
731
 
732
      if Token /= Tok_Pragma then
733
         return False;
734
      end if;
735
 
736
      Scan; -- past pragma
737
 
738
      if Token /= Tok_Identifier
739
        or else Chars (Token_Node) /= Name_No_Body
740
      then
741
         return False;
742
      end if;
743
 
744
      Scan; -- past No_Body
745
 
746
      if Token /= Tok_Semicolon then
747
         return False;
748
      end if;
749
 
750
      Scan; -- past semicolon
751
 
752
      return Token = Tok_EOF;
753
   end Source_File_Is_No_Body;
754
 
755
   ----------------------------
756
   -- Source_File_Is_Subunit --
757
   ----------------------------
758
 
759
   function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
760
   begin
761
      Initialize_Scanner (No_Unit, X);
762
 
763
      --  We scan past junk to the first interesting compilation unit token, to
764
      --  see if it is SEPARATE. We ignore WITH keywords during this and also
765
      --  PRIVATE. The reason for ignoring PRIVATE is that it handles some
766
      --  error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
767
 
768
      while Token = Tok_With
769
        or else Token = Tok_Private
770
        or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
771
      loop
772
         Scan;
773
      end loop;
774
 
775
      return Token = Tok_Separate;
776
   end Source_File_Is_Subunit;
777
 
778
end Sinput.L;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.