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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [sinput-p.adb] - Blame information for rev 826

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 . P                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2008, 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 Ada.Unchecked_Conversion;
27
with Ada.Unchecked_Deallocation;
28
 
29
with Prj.Err;
30
with Sinput.C;
31
 
32
with System;
33
 
34
package body Sinput.P is
35
 
36
   First : Boolean := True;
37
   --  Flag used when Load_Project_File is called the first time,
38
   --  to set Main_Source_File.
39
   --  The flag is reset to False at the first call to Load_Project_File.
40
   --  Calling Reset_First sets it back to True.
41
 
42
   procedure Free is new Ada.Unchecked_Deallocation
43
     (Lines_Table_Type, Lines_Table_Ptr);
44
 
45
   procedure Free is new Ada.Unchecked_Deallocation
46
     (Logical_Lines_Table_Type, Logical_Lines_Table_Ptr);
47
 
48
   -----------------------------
49
   -- Clear_Source_File_Table --
50
   -----------------------------
51
 
52
   procedure Clear_Source_File_Table is
53
      use System;
54
 
55
   begin
56
      for X in 1 .. Source_File.Last loop
57
         declare
58
            S  : Source_File_Record renames Source_File.Table (X);
59
            Lo : constant Source_Ptr := S.Source_First;
60
            Hi : constant Source_Ptr := S.Source_Last;
61
            subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
62
            --  Physical buffer allocated
63
 
64
            type Actual_Source_Ptr is access Actual_Source_Buffer;
65
            --  This is the pointer type for the physical buffer allocated
66
 
67
            procedure Free is new Ada.Unchecked_Deallocation
68
              (Actual_Source_Buffer, Actual_Source_Ptr);
69
 
70
            pragma Suppress (All_Checks);
71
 
72
            pragma Warnings (Off);
73
            --  The following unchecked conversion is aliased safe, since it
74
            --  is not used to create improperly aliased pointer values.
75
 
76
            function To_Actual_Source_Ptr is new
77
              Ada.Unchecked_Conversion (Address, Actual_Source_Ptr);
78
 
79
            pragma Warnings (On);
80
 
81
            Actual_Ptr : Actual_Source_Ptr :=
82
                           To_Actual_Source_Ptr (S.Source_Text (Lo)'Address);
83
 
84
         begin
85
            Free (Actual_Ptr);
86
            Free (S.Lines_Table);
87
            Free (S.Logical_Lines_Table);
88
         end;
89
      end loop;
90
 
91
      Source_File.Free;
92
      Sinput.Initialize;
93
   end Clear_Source_File_Table;
94
 
95
   -----------------------
96
   -- Load_Project_File --
97
   -----------------------
98
 
99
   function Load_Project_File (Path : String) return Source_File_Index is
100
      X    : Source_File_Index;
101
 
102
   begin
103
      X := Sinput.C.Load_File (Path);
104
 
105
      if First then
106
         Main_Source_File := X;
107
         First := False;
108
      end if;
109
 
110
      return X;
111
   end Load_Project_File;
112
 
113
   -----------------
114
   -- Reset_First --
115
   -----------------
116
 
117
   procedure Reset_First is
118
   begin
119
      First := True;
120
   end Reset_First;
121
 
122
   --------------------------------
123
   -- Restore_Project_Scan_State --
124
   --------------------------------
125
 
126
   procedure Restore_Project_Scan_State
127
     (Saved_State : Saved_Project_Scan_State)
128
   is
129
   begin
130
      Restore_Scan_State (Saved_State.Scan_State);
131
      Source              := Saved_State.Source;
132
      Current_Source_File := Saved_State.Current_Source_File;
133
   end Restore_Project_Scan_State;
134
 
135
   -----------------------------
136
   -- Save_Project_Scan_State --
137
   -----------------------------
138
 
139
   procedure Save_Project_Scan_State
140
     (Saved_State : out Saved_Project_Scan_State)
141
   is
142
   begin
143
      Save_Scan_State (Saved_State.Scan_State);
144
      Saved_State.Source              := Source;
145
      Saved_State.Current_Source_File := Current_Source_File;
146
   end Save_Project_Scan_State;
147
 
148
   ----------------------------
149
   -- Source_File_Is_Subunit --
150
   ----------------------------
151
 
152
   function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
153
   begin
154
      Prj.Err.Scanner.Initialize_Scanner (X);
155
 
156
      --  No error for special characters that are used for preprocessing
157
 
158
      Prj.Err.Scanner.Set_Special_Character ('#');
159
      Prj.Err.Scanner.Set_Special_Character ('$');
160
 
161
      --  We scan past junk to the first interesting compilation unit token, to
162
      --  see if it is SEPARATE. We ignore WITH keywords during this and also
163
      --  PRIVATE. The reason for ignoring PRIVATE is that it handles some
164
      --  error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
165
 
166
      while Token = Tok_With
167
        or else Token = Tok_Private
168
        or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
169
      loop
170
         Prj.Err.Scanner.Scan;
171
      end loop;
172
 
173
      Prj.Err.Scanner.Reset_Special_Characters;
174
 
175
      return Token = Tok_Separate;
176
   end Source_File_Is_Subunit;
177
 
178
end Sinput.P;

powered by: WebSVN 2.1.0

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