OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [xsinfo.adb] - Blame information for rev 410

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                          GNAT SYSTEM UTILITIES                           --
4
--                                                                          --
5
--                               X S I N F O                                --
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
--  Program to construct C header file sinfo.h (C version of sinfo.ads spec,
27
--  for use by Gigi, contains all definitions and access functions, but does
28
--  not contain set procedures, since Gigi never modifies the GNAT tree)
29
 
30
--    Input files:
31
 
32
--       sinfo.ads     Spec of Sinfo package
33
 
34
--    Output files:
35
 
36
--       sinfo.h       Corresponding c header file
37
 
38
--  Note: this program assumes that sinfo.ads has passed the error checks
39
--  which are carried out by the CSinfo utility, so it does not duplicate
40
--  these checks and assumes the source is correct.
41
 
42
--  An optional argument allows the specification of an output file name to
43
--  override the default sinfo.h file name for the generated output file.
44
 
45
with Ada.Command_Line;              use Ada.Command_Line;
46
with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
47
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
48
with Ada.Text_IO;                   use Ada.Text_IO;
49
 
50
with GNAT.Spitbol;                  use GNAT.Spitbol;
51
with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
52
 
53
procedure XSinfo is
54
 
55
   Done : exception;
56
   Err  : exception;
57
 
58
   A         : VString := Nul;
59
   Arg       : VString := Nul;
60
   Comment   : VString := Nul;
61
   Line      : VString := Nul;
62
   N         : VString := Nul;
63
   N1, N2    : VString := Nul;
64
   Nam       : VString := Nul;
65
   Rtn       : VString := Nul;
66
   Term      : VString := Nul;
67
 
68
   InS   : File_Type;
69
   Ofile : File_Type;
70
 
71
   wsp     : constant Pattern := Span (' ' & ASCII.HT);
72
   Wsp_For : constant Pattern := wsp & "for";
73
   Is_Cmnt : constant Pattern := wsp & "--";
74
   Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
75
   Get_Nam : constant Pattern := wsp * A & "N_" &  Break (",)") * Nam
76
                                 & Len (1) * Term;
77
   Sub_Typ : constant Pattern := wsp * A & "subtype " &  Break (' ') * N;
78
   No_Cont : constant Pattern := wsp & Break (' ') * N1
79
                                 & " .. " & Break (';') * N2;
80
   Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
81
   Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
82
   Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
83
   Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
84
                                 & ") return " & Break (';') * Rtn
85
                                 & ';' & wsp & "--" & wsp & Rest * Comment;
86
 
87
   NKV : Natural;
88
 
89
   M : Match_Result;
90
 
91
   procedure Getline;
92
   --  Get non-comment, non-blank line. Also skips "for " rep clauses
93
 
94
   -------------
95
   -- Getline --
96
   -------------
97
 
98
   procedure Getline is
99
   begin
100
      loop
101
         Line := Get_Line (InS);
102
 
103
         if Line /= ""
104
           and then not Match (Line, Wsp_For)
105
           and then not Match (Line, Is_Cmnt)
106
         then
107
            return;
108
 
109
         elsif Match (Line, "   --  End functions (note") then
110
            raise Done;
111
         end if;
112
      end loop;
113
   end Getline;
114
 
115
--  Start of processing for XSinfo
116
 
117
begin
118
   Set_Exit_Status (1);
119
   Anchored_Mode := True;
120
 
121
   if Argument_Count > 0 then
122
      Create (Ofile, Out_File, Argument (1));
123
   else
124
      Create (Ofile, Out_File, "sinfo.h");
125
   end if;
126
 
127
   Open (InS, In_File, "sinfo.ads");
128
 
129
   --  Write header to output file
130
 
131
   loop
132
      Line := Get_Line (InS);
133
      exit when Line = "";
134
 
135
      Match
136
        (Line,
137
         "--                                 S p e c       ",
138
         "--                              C Header File    ");
139
 
140
      Match (Line, "--", "/*");
141
      Match (Line, Rtab (2) * A & "--", M);
142
      Replace (M, A & "*/");
143
      Put_Line (Ofile, Line);
144
   end loop;
145
 
146
   --  Skip to package line
147
 
148
   loop
149
      Getline;
150
      exit when Match (Line, "package");
151
   end loop;
152
 
153
   --  Skip to first node kind line
154
 
155
   loop
156
      Getline;
157
      exit when Match (Line, Typ_Nod);
158
      Put_Line (Ofile, Line);
159
   end loop;
160
 
161
   Put_Line (Ofile, "");
162
   NKV := 0;
163
 
164
   --  Loop through node kind codes
165
 
166
   loop
167
      Getline;
168
 
169
      if Match (Line, Get_Nam) then
170
         Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
171
         NKV := NKV + 1;
172
         exit when not Match (Term, ",");
173
 
174
      else
175
         Put_Line (Ofile, Line);
176
      end if;
177
   end loop;
178
 
179
   Put_Line (Ofile, "");
180
   Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
181
 
182
   --  Loop through subtype declarations
183
 
184
   loop
185
      Getline;
186
 
187
      if not Match (Line, Sub_Typ) then
188
         exit when Match (Line, "   function");
189
         Put_Line (Ofile, Line);
190
 
191
      else
192
         Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
193
         Getline;
194
 
195
         --  Normal case
196
 
197
         if Match (Line, No_Cont) then
198
            Put_Line (Ofile, A & "   " & N1 & ", " & N2 & ')');
199
 
200
         --  Continuation case
201
 
202
         else
203
            if not Match (Line, Cont_N1) then
204
               raise Err;
205
            end if;
206
 
207
            Getline;
208
 
209
            if not Match (Line, Cont_N2) then
210
               raise Err;
211
            end if;
212
 
213
            Put_Line (Ofile,  A & "   " & N1 & ',');
214
            Put_Line (Ofile,  A & "   " & N2 & ')');
215
         end if;
216
      end if;
217
   end loop;
218
 
219
   --  Loop through functions. Note that this loop is terminated by
220
   --  the call to Getfile encountering the end of functions sentinel
221
 
222
   loop
223
      if Match (Line, Is_Func) then
224
         Getline;
225
            if not Match (Line, Get_Arg) then
226
               raise Err;
227
            end if;
228
         Put_Line
229
           (Ofile,
230
            A &  "INLINE " & Rpad (Rtn, 9)
231
            & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
232
 
233
         Put_Line (Ofile,  A & "   { return " & Comment & " (N); }");
234
 
235
      else
236
         Put_Line (Ofile, Line);
237
      end if;
238
 
239
      Getline;
240
   end loop;
241
 
242
exception
243
   when Done =>
244
      Put_Line (Ofile, "");
245
      Set_Exit_Status (0);
246
 
247
end XSinfo;

powered by: WebSVN 2.1.0

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