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/] [xnmake.adb] - Blame information for rev 414

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 N M A K E                                --
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 the spec and body of the Nmake package
27
 
28
--    Input files:
29
 
30
--       sinfo.ads     Spec of Sinfo package
31
--       nmake.adt     Template for Nmake package
32
 
33
--    Output files:
34
 
35
--       nmake.ads     Spec of Nmake package
36
--       nmake.adb     Body of Nmake package
37
 
38
--  Note: this program assumes that sinfo.ads has passed the error checks that
39
--  are carried out by the csinfo utility, so it does not duplicate these
40
--  checks and assumes that sinfo.ads has the correct form.
41
 
42
--   In the absence of any switches, both the ads and adb files are output.
43
--   The switch -s or /s indicates that only the ads file is to be output.
44
--   The switch -b or /b indicates that only the adb file is to be output.
45
 
46
--   If a file name argument is given, then the output is written to this file
47
--   rather than to nmake.ads or nmake.adb. A file name can only be given if
48
--   exactly one of the -s or -b options is present.
49
 
50
with Ada.Command_Line;              use Ada.Command_Line;
51
with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
52
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
53
with Ada.Strings.Maps;              use Ada.Strings.Maps;
54
with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
55
with Ada.Streams.Stream_IO;         use Ada.Streams.Stream_IO;
56
with Ada.Text_IO;                   use Ada.Text_IO;
57
 
58
with GNAT.Spitbol;                  use GNAT.Spitbol;
59
with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
60
 
61
with XUtil;
62
 
63
procedure XNmake is
64
 
65
   Err : exception;
66
   --  Raised to terminate execution
67
 
68
   A        : VString := Nul;
69
   Arg      : VString := Nul;
70
   Arg_List : VString := Nul;
71
   Comment  : VString := Nul;
72
   Default  : VString := Nul;
73
   Field    : VString := Nul;
74
   Line     : VString := Nul;
75
   Node     : VString := Nul;
76
   Op_Name  : VString := Nul;
77
   Prevl    : VString := Nul;
78
   Synonym  : VString := Nul;
79
   X        : VString := Nul;
80
 
81
   NWidth : Natural;
82
 
83
   FileS : VString := V ("nmake.ads");
84
   FileB : VString := V ("nmake.adb");
85
   --  Set to null if corresponding file not to be generated
86
 
87
   Given_File : VString := Nul;
88
   --  File name given by command line argument
89
 
90
   subtype Sfile is Ada.Streams.Stream_IO.File_Type;
91
 
92
   InS,  InT  : Ada.Text_IO.File_Type;
93
   OutS, OutB : Sfile;
94
 
95
   wsp : constant Pattern := Span (' ' & ASCII.HT);
96
 
97
   Body_Only : constant Pattern := BreakX (' ') * X
98
                                   & Span (' ') & "--  body only";
99
   Spec_Only : constant Pattern := BreakX (' ') * X
100
                                   & Span (' ') & "--  spec only";
101
 
102
   Node_Hdr  : constant Pattern := wsp & "--  N_" & Rest * Node;
103
   Punc      : constant Pattern := BreakX (" .,");
104
 
105
   Binop     : constant Pattern := wsp
106
                                   & "--  plus fields for binary operator";
107
   Unop      : constant Pattern := wsp
108
                                   & "--  plus fields for unary operator";
109
   Syn       : constant Pattern := wsp & "--  " & Break (' ') * Synonym
110
                                   & " (" & Break (')') * Field
111
                                   & Rest * Comment;
112
 
113
   Templ     : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
114
   Spec      : constant Pattern := BreakX ('S') * A & "S p e c";
115
 
116
   Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
117
   Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
118
 
119
   Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
120
 
121
   Get_Dflt  : constant Pattern := BreakX ('(') & "(set to "
122
                                   & Break (" ") * Default & " if";
123
 
124
   Next_Arg  : constant Pattern := Break (',') * Arg & ',';
125
 
126
   Op_Node   : constant Pattern := "Op_" & Rest * Op_Name;
127
 
128
   Shft_Rot  : constant Pattern := "Shift_" or "Rotate_";
129
 
130
   No_Ent    : constant Pattern := "Or_Else" or "And_Then"
131
                                     or "In" or "Not_In";
132
 
133
   M : Match_Result;
134
 
135
   V_String_Id : constant VString := V ("String_Id");
136
   V_Node_Id   : constant VString := V ("Node_Id");
137
   V_Name_Id   : constant VString := V ("Name_Id");
138
   V_List_Id   : constant VString := V ("List_Id");
139
   V_Elist_Id  : constant VString := V ("Elist_Id");
140
   V_Boolean   : constant VString := V ("Boolean");
141
 
142
   procedure Put_Line (F : Sfile; S : String)  renames XUtil.Put_Line;
143
   procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line;
144
   --  Local version of Put_Line ensures Unix style line endings
145
 
146
   procedure WriteS  (S : String);
147
   procedure WriteB  (S : String);
148
   procedure WriteBS (S : String);
149
   procedure WriteS  (S : VString);
150
   procedure WriteB  (S : VString);
151
   procedure WriteBS (S : VString);
152
   --  Write given line to spec or body file or both if active
153
 
154
   procedure WriteB (S : String) is
155
   begin
156
      if FileB /= Nul then
157
         Put_Line (OutB, S);
158
      end if;
159
   end WriteB;
160
 
161
   procedure WriteB (S : VString) is
162
   begin
163
      if FileB /= Nul then
164
         Put_Line (OutB, S);
165
      end if;
166
   end WriteB;
167
 
168
   procedure WriteBS (S : String) is
169
   begin
170
      if FileB /= Nul then
171
         Put_Line (OutB, S);
172
      end if;
173
 
174
      if FileS /= Nul then
175
         Put_Line (OutS, S);
176
      end if;
177
   end WriteBS;
178
 
179
   procedure WriteBS (S : VString) is
180
   begin
181
      if FileB /= Nul then
182
         Put_Line (OutB, S);
183
      end if;
184
 
185
      if FileS /= Nul then
186
         Put_Line (OutS, S);
187
      end if;
188
   end WriteBS;
189
 
190
   procedure WriteS (S : String) is
191
   begin
192
      if FileS /= Nul then
193
         Put_Line (OutS, S);
194
      end if;
195
   end WriteS;
196
 
197
   procedure WriteS (S : VString) is
198
   begin
199
      if FileS /= Nul then
200
         Put_Line (OutS, S);
201
      end if;
202
   end WriteS;
203
 
204
--  Start of processing for XNmake
205
 
206
begin
207
   NWidth := 28;
208
   Anchored_Mode := True;
209
 
210
   for ArgN in 1 .. Argument_Count loop
211
      declare
212
         Arg : constant String := Argument (ArgN);
213
 
214
      begin
215
         if Arg (1) = '-' then
216
            if Arg'Length = 2
217
              and then (Arg (2) = 'b' or else Arg (2) = 'B')
218
            then
219
               FileS := Nul;
220
 
221
            elsif Arg'Length = 2
222
              and then (Arg (2) = 's' or else Arg (2) = 'S')
223
            then
224
               FileB := Nul;
225
 
226
            else
227
               raise Err;
228
            end if;
229
 
230
         else
231
            if Given_File /= Nul then
232
               raise Err;
233
            else
234
               Given_File := V (Arg);
235
            end if;
236
         end if;
237
      end;
238
   end loop;
239
 
240
   if FileS = Nul and then FileB = Nul then
241
      raise Err;
242
 
243
   elsif Given_File /= Nul then
244
      if FileB = Nul then
245
         FileS := Given_File;
246
 
247
      elsif FileS = Nul then
248
         FileB := Given_File;
249
 
250
      else
251
         raise Err;
252
      end if;
253
   end if;
254
 
255
   Open (InS, In_File, "sinfo.ads");
256
   Open (InT, In_File, "nmake.adt");
257
 
258
   if FileS /= Nul then
259
      Create (OutS, Out_File, S (FileS));
260
   end if;
261
 
262
   if FileB /= Nul then
263
      Create (OutB, Out_File, S (FileB));
264
   end if;
265
 
266
   Anchored_Mode := True;
267
 
268
   --  Copy initial part of template to spec and body
269
 
270
   loop
271
      Line := Get_Line (InT);
272
 
273
      --  Skip lines describing the template
274
 
275
      if Match (Line, "--  This file is a template") then
276
         loop
277
            Line := Get_Line (InT);
278
            exit when Line = "";
279
         end loop;
280
      end if;
281
 
282
      --  Loop keeps going until "package" keyword written
283
 
284
      exit when Match (Line, "package");
285
 
286
      --  Deal with WITH lines, writing to body or spec as appropriate
287
 
288
      if Match (Line, Body_Only, M) then
289
         Replace (M, X);
290
         WriteB (Line);
291
 
292
      elsif Match (Line, Spec_Only, M) then
293
         Replace (M, X);
294
         WriteS (Line);
295
 
296
      --  Change header from Template to Spec and write to spec file
297
 
298
      else
299
         if Match (Line, Templ, M) then
300
            Replace (M, A &  "    S p e c    ");
301
         end if;
302
 
303
         WriteS (Line);
304
 
305
         --  Write header line to body file
306
 
307
         if Match (Line, Spec, M) then
308
            Replace (M, A &  "B o d y");
309
         end if;
310
 
311
         WriteB (Line);
312
      end if;
313
   end loop;
314
 
315
   --  Package line reached
316
 
317
   WriteS ("package Nmake is");
318
   WriteB ("package body Nmake is");
319
   WriteB ("");
320
 
321
   --  Copy rest of lines up to template insert point to spec only
322
 
323
   loop
324
      Line := Get_Line (InT);
325
      exit when Match (Line, "!!TEMPLATE INSERTION POINT");
326
      WriteS (Line);
327
   end loop;
328
 
329
   --  Here we are doing the actual insertions, loop through node types
330
 
331
   loop
332
      Line := Get_Line (InS);
333
 
334
      if Match (Line, Node_Hdr)
335
        and then not Match (Node, Punc)
336
        and then Node /= "Unused"
337
      then
338
         exit when Node = "Empty";
339
         Prevl := "   function Make_" & Node & " (Sloc : Source_Ptr";
340
         Arg_List := Nul;
341
 
342
         --  Loop through fields of one node
343
 
344
         loop
345
            Line := Get_Line (InS);
346
            exit when Line = "";
347
 
348
            if Match (Line, Binop) then
349
               WriteBS (Prevl & ';');
350
               Append (Arg_List, "Left_Opnd,Right_Opnd,");
351
               WriteBS (
352
                 "      " & Rpad ("Left_Opnd",  NWidth) & " : Node_Id;");
353
               Prevl :=
354
                 "      " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
355
 
356
            elsif Match (Line, Unop) then
357
               WriteBS (Prevl & ';');
358
               Append (Arg_List, "Right_Opnd,");
359
               Prevl := "      " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
360
 
361
            elsif Match (Line, Syn) then
362
               if         Synonym /= "Prev_Ids"
363
                 and then Synonym /= "More_Ids"
364
                 and then Synonym /= "Comes_From_Source"
365
                 and then Synonym /= "Paren_Count"
366
                 and then not Match (Field, Sem_Field)
367
                 and then not Match (Field, Lib_Field)
368
               then
369
                  Match (Field, Get_Field);
370
 
371
                  if    Field = "Str"   then
372
                     Field := V_String_Id;
373
                  elsif Field = "Node"  then
374
                     Field := V_Node_Id;
375
                  elsif Field = "Name"  then
376
                     Field := V_Name_Id;
377
                  elsif Field = "List"  then
378
                     Field := V_List_Id;
379
                  elsif Field = "Elist" then
380
                     Field := V_Elist_Id;
381
                  elsif Field = "Flag"  then
382
                     Field := V_Boolean;
383
                  end if;
384
 
385
                  if Field = "Boolean" then
386
                     Default := V ("False");
387
                  else
388
                     Default := Nul;
389
                  end if;
390
 
391
                  Match (Comment, Get_Dflt);
392
 
393
                  WriteBS (Prevl & ';');
394
                  Append (Arg_List, Synonym & ',');
395
                  Rpad (Synonym, NWidth);
396
 
397
                  if Default = "" then
398
                     Prevl := "      " & Synonym & " : " & Field;
399
                  else
400
                     Prevl :=
401
                       "      " & Synonym & " : " & Field & " := " & Default;
402
                  end if;
403
               end if;
404
            end if;
405
         end loop;
406
 
407
         WriteBS (Prevl & ')');
408
         WriteS ("      return Node_Id;");
409
         WriteS ("   pragma Inline (Make_" & Node & ");");
410
         WriteB ("      return Node_Id");
411
         WriteB ("   is");
412
         WriteB ("      N : constant Node_Id :=");
413
 
414
         if Match (Node, "Defining_Identifier") or else
415
            Match (Node, "Defining_Character")  or else
416
            Match (Node, "Defining_Operator")
417
         then
418
            WriteB ("            New_Entity (N_" & Node & ", Sloc);");
419
         else
420
            WriteB ("            New_Node (N_" & Node & ", Sloc);");
421
         end if;
422
 
423
         WriteB ("   begin");
424
 
425
         while Match (Arg_List, Next_Arg, "") loop
426
            if Length (Arg) < NWidth then
427
               WriteB ("      Set_" & Arg & " (N, " & Arg & ");");
428
            else
429
               WriteB ("      Set_" & Arg);
430
               WriteB ("        (N, " & Arg & ");");
431
            end if;
432
         end loop;
433
 
434
         if Match (Node, Op_Node) then
435
            if Node = "Op_Plus" then
436
               WriteB ("      Set_Chars (N, Name_Op_Add);");
437
 
438
            elsif Node = "Op_Minus" then
439
               WriteB ("      Set_Chars (N, Name_Op_Subtract);");
440
 
441
            elsif Match (Op_Name, Shft_Rot) then
442
               WriteB ("      Set_Chars (N, Name_" & Op_Name & ");");
443
 
444
            else
445
               WriteB ("      Set_Chars (N, Name_" & Node & ");");
446
            end if;
447
 
448
            if not Match (Op_Name, No_Ent) then
449
               WriteB ("      Set_Entity (N, Standard_" & Node & ");");
450
            end if;
451
         end if;
452
 
453
         WriteB ("      return N;");
454
         WriteB ("   end Make_" & Node & ';');
455
         WriteBS ("");
456
      end if;
457
   end loop;
458
 
459
   WriteBS ("end Nmake;");
460
 
461
exception
462
 
463
   when Err =>
464
      Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]");
465
      Set_Exit_Status (1);
466
 
467
end XNmake;

powered by: WebSVN 2.1.0

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