Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/xoscons.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT SYSTEM UTILITIES -- | |
4 -- -- | |
5 -- X O S C O N S -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 2008-2017, 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 -- The base name of the template file is given by Argument (1). This program | |
27 -- generates the spec for this specified unit (let's call it UNIT_NAME). | |
28 | |
29 -- It works in conjunction with a C template file which must be preprocessed | |
30 -- and compiled using the cross compiler. Two input files are used: | |
31 -- - the preprocessed C file: UNIT_NAME-tmplt.i | |
32 -- - the generated assembly file: UNIT_NAME-tmplt.s | |
33 | |
34 -- The generated files are UNIT_NAME.ads and UNIT_NAME.h | |
35 | |
36 with Ada.Characters.Handling; use Ada.Characters.Handling; | |
37 with Ada.Command_Line; use Ada.Command_Line; | |
38 with Ada.Exceptions; use Ada.Exceptions; | |
39 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; | |
40 with Ada.Strings.Fixed; use Ada.Strings.Fixed; | |
41 with Ada.Strings.Maps; use Ada.Strings.Maps; | |
42 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; | |
43 with Ada.Text_IO; use Ada.Text_IO; | |
44 | |
45 pragma Warnings (Off); | |
46 -- System.Unsigned_Types is an internal GNAT unit | |
47 with System.Unsigned_Types; use System.Unsigned_Types; | |
48 pragma Warnings (On); | |
49 | |
50 with GNAT.OS_Lib; | |
51 with GNAT.String_Split; use GNAT.String_Split; | |
52 with GNAT.Table; | |
53 | |
54 with XUtil; use XUtil; | |
55 | |
56 procedure XOSCons is | |
57 | |
58 use Ada.Strings; | |
59 | |
60 Unit_Name : constant String := Argument (1); | |
61 Tmpl_Name : constant String := Unit_Name & "-tmplt"; | |
62 | |
63 ------------------------------------------------- | |
64 -- Information retrieved from assembly listing -- | |
65 ------------------------------------------------- | |
66 | |
67 type String_Access is access all String; | |
68 -- Note: we can't use GNAT.Strings for this definition, since that unit | |
69 -- is not available in older base compilers. | |
70 | |
71 -- We need to deal with integer values that can be signed or unsigned, so | |
72 -- we need to accommodate the maximum range of both cases. | |
73 | |
74 type Int_Value_Type is record | |
75 Positive : Boolean; | |
76 Abs_Value : Long_Unsigned := 0; | |
77 end record; | |
78 | |
79 function ">" (V1, V2 : Int_Value_Type) return Boolean; | |
80 function "<" (V1, V2 : Int_Value_Type) return Boolean; | |
81 | |
82 type Asm_Info_Kind is | |
83 (CND, -- Named number (decimal) | |
84 CNU, -- Named number (decimal, unsigned) | |
85 CNS, -- Named number (freeform text) | |
86 C, -- Constant object | |
87 SUB, -- Subtype | |
88 TXT); -- Literal text | |
89 -- Recognized markers found in assembly file. These markers are produced by | |
90 -- the same-named macros from the C template. | |
91 | |
92 subtype Asm_Int_Kind is Asm_Info_Kind range CND .. CNU; | |
93 -- Asm_Info_Kind values with int values in input | |
94 | |
95 subtype Named_Number is Asm_Info_Kind range CND .. CNS; | |
96 -- Asm_Info_Kind values with named numbers in output | |
97 | |
98 type Asm_Info (Kind : Asm_Info_Kind := TXT) is record | |
99 Line_Number : Integer; | |
100 -- Line number in C source file | |
101 | |
102 Constant_Name : String_Access; | |
103 -- Name of constant to be defined | |
104 | |
105 Constant_Type : String_Access; | |
106 -- Type of constant (case of Kind = C) | |
107 | |
108 Value_Len : Natural := 0; | |
109 -- Length of text representation of constant's value | |
110 | |
111 Text_Value : String_Access; | |
112 -- Value for CNS / C constant | |
113 | |
114 Int_Value : Int_Value_Type; | |
115 -- Value for CND / CNU constant | |
116 | |
117 Comment : String_Access; | |
118 -- Additional descriptive comment for constant, or free-form text (TXT) | |
119 end record; | |
120 | |
121 package Asm_Infos is new GNAT.Table | |
122 (Table_Component_Type => Asm_Info, | |
123 Table_Index_Type => Integer, | |
124 Table_Low_Bound => 1, | |
125 Table_Initial => 100, | |
126 Table_Increment => 10); | |
127 | |
128 Max_Constant_Name_Len : Natural := 0; | |
129 Max_Constant_Value_Len : Natural := 0; | |
130 Max_Constant_Type_Len : Natural := 0; | |
131 -- Lengths of longest name and longest value | |
132 | |
133 Size_Of_Unsigned_Int : Integer := 0; | |
134 -- Size of unsigned int on target | |
135 | |
136 type Language is (Lang_Ada, Lang_C); | |
137 | |
138 function Parse_Int (S : String; K : Asm_Int_Kind) return Int_Value_Type; | |
139 -- Parse a decimal number, preceded by an optional '$' or '#' character, | |
140 -- and return its value. | |
141 | |
142 procedure Output_Info | |
143 (Lang : Language; | |
144 OFile : Sfile; | |
145 Info_Index : Integer); | |
146 -- Output information from the indicated asm info line | |
147 | |
148 procedure Parse_Asm_Line (Line : String); | |
149 -- Parse one information line from the assembly source | |
150 | |
151 function Contains_Template_Name (S : String) return Boolean; | |
152 -- True if S contains Tmpl_Name, possibly with different casing | |
153 | |
154 function Spaces (Count : Integer) return String; | |
155 -- If Count is positive, return a string of Count spaces, else return | |
156 -- an empty string. | |
157 | |
158 --------- | |
159 -- ">" -- | |
160 --------- | |
161 | |
162 function ">" (V1, V2 : Int_Value_Type) return Boolean is | |
163 P1 : Boolean renames V1.Positive; | |
164 P2 : Boolean renames V2.Positive; | |
165 A1 : Long_Unsigned renames V1.Abs_Value; | |
166 A2 : Long_Unsigned renames V2.Abs_Value; | |
167 begin | |
168 return (P1 and then not P2) | |
169 or else (P1 and then P2 and then A1 > A2) | |
170 or else (not P1 and then not P2 and then A1 < A2); | |
171 end ">"; | |
172 | |
173 --------- | |
174 -- "<" -- | |
175 --------- | |
176 | |
177 function "<" (V1, V2 : Int_Value_Type) return Boolean is | |
178 begin | |
179 return not (V1 > V2) and then not (V1 = V2); | |
180 end "<"; | |
181 | |
182 ---------------------------- | |
183 -- Contains_Template_Name -- | |
184 ---------------------------- | |
185 | |
186 function Contains_Template_Name (S : String) return Boolean is | |
187 begin | |
188 if Index (Source => To_Lower (S), Pattern => Tmpl_Name) > 0 then | |
189 return True; | |
190 else | |
191 return False; | |
192 end if; | |
193 end Contains_Template_Name; | |
194 | |
195 ----------------- | |
196 -- Output_Info -- | |
197 ----------------- | |
198 | |
199 procedure Output_Info | |
200 (Lang : Language; | |
201 OFile : Sfile; | |
202 Info_Index : Integer) | |
203 is | |
204 Info : Asm_Info renames Asm_Infos.Table (Info_Index); | |
205 | |
206 procedure Put (S : String); | |
207 -- Write S to OFile | |
208 | |
209 --------- | |
210 -- Put -- | |
211 --------- | |
212 | |
213 procedure Put (S : String) is | |
214 begin | |
215 Put (OFile, S); | |
216 end Put; | |
217 | |
218 -- Start of processing for Output_Info | |
219 | |
220 begin | |
221 case Info.Kind is | |
222 when TXT => | |
223 | |
224 -- Handled in the common code for comments below | |
225 | |
226 null; | |
227 | |
228 when SUB => | |
229 case Lang is | |
230 when Lang_Ada => | |
231 Put (" subtype " & Info.Constant_Name.all | |
232 & " is Interfaces.C." | |
233 & Info.Text_Value.all & ";"); | |
234 when Lang_C => | |
235 Put ("#define " & Info.Constant_Name.all & " " | |
236 & Info.Text_Value.all); | |
237 end case; | |
238 | |
239 when others => | |
240 | |
241 -- All named number cases | |
242 | |
243 case Lang is | |
244 when Lang_Ada => | |
245 Put (" " & Info.Constant_Name.all); | |
246 Put (Spaces (Max_Constant_Name_Len | |
247 - Info.Constant_Name'Length)); | |
248 | |
249 if Info.Kind in Named_Number then | |
250 Put (" : constant := "); | |
251 else | |
252 Put (" : constant " & Info.Constant_Type.all); | |
253 Put (Spaces (Max_Constant_Type_Len | |
254 - Info.Constant_Type'Length)); | |
255 Put (" := "); | |
256 end if; | |
257 | |
258 when Lang_C => | |
259 Put ("#define " & Info.Constant_Name.all & " "); | |
260 Put (Spaces (Max_Constant_Name_Len | |
261 - Info.Constant_Name'Length)); | |
262 end case; | |
263 | |
264 if Info.Kind in Asm_Int_Kind then | |
265 if not Info.Int_Value.Positive then | |
266 Put ("-"); | |
267 end if; | |
268 | |
269 Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left)); | |
270 | |
271 else | |
272 declare | |
273 Is_String : constant Boolean := | |
274 Info.Kind = C | |
275 and then Info.Constant_Type.all = "String"; | |
276 | |
277 begin | |
278 if Is_String then | |
279 Put (""""); | |
280 end if; | |
281 | |
282 Put (Info.Text_Value.all); | |
283 | |
284 if Is_String then | |
285 Put (""""); | |
286 end if; | |
287 end; | |
288 end if; | |
289 | |
290 if Lang = Lang_Ada then | |
291 Put (";"); | |
292 | |
293 if Info.Comment'Length > 0 then | |
294 Put (Spaces (Max_Constant_Value_Len - Info.Value_Len)); | |
295 Put (" -- "); | |
296 end if; | |
297 end if; | |
298 end case; | |
299 | |
300 if Lang = Lang_Ada then | |
301 Put (Info.Comment.all); | |
302 end if; | |
303 | |
304 New_Line (OFile); | |
305 end Output_Info; | |
306 | |
307 -------------------- | |
308 -- Parse_Asm_Line -- | |
309 -------------------- | |
310 | |
311 procedure Parse_Asm_Line (Line : String) is | |
312 Index1, Index2 : Integer := Line'First; | |
313 | |
314 function Field_Alloc return String_Access; | |
315 -- Allocate and return a copy of Line (Index1 .. Index2 - 1) | |
316 | |
317 procedure Find_Colon (Index : in out Integer); | |
318 -- Increment Index until the next colon in Line | |
319 | |
320 ----------------- | |
321 -- Field_Alloc -- | |
322 ----------------- | |
323 | |
324 function Field_Alloc return String_Access is | |
325 begin | |
326 return new String'(Line (Index1 .. Index2 - 1)); | |
327 end Field_Alloc; | |
328 | |
329 ---------------- | |
330 -- Find_Colon -- | |
331 ---------------- | |
332 | |
333 procedure Find_Colon (Index : in out Integer) is | |
334 begin | |
335 loop | |
336 Index := Index + 1; | |
337 exit when Index > Line'Last or else Line (Index) = ':'; | |
338 end loop; | |
339 end Find_Colon; | |
340 | |
341 -- Start of processing for Parse_Asm_Line | |
342 | |
343 begin | |
344 Find_Colon (Index2); | |
345 | |
346 declare | |
347 Info : Asm_Info (Kind => Asm_Info_Kind'Value | |
348 (Line (Line'First .. Index2 - 1))); | |
349 begin | |
350 Index1 := Index2 + 1; | |
351 Find_Colon (Index2); | |
352 | |
353 Info.Line_Number := | |
354 Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value); | |
355 | |
356 case Info.Kind is | |
357 when C | |
358 | CND | |
359 | CNS | |
360 | CNU | |
361 | SUB | |
362 => | |
363 Index1 := Index2 + 1; | |
364 Find_Colon (Index2); | |
365 | |
366 Info.Constant_Name := Field_Alloc; | |
367 | |
368 if Info.Kind /= SUB | |
369 and then | |
370 Info.Constant_Name'Length > Max_Constant_Name_Len | |
371 then | |
372 Max_Constant_Name_Len := Info.Constant_Name'Length; | |
373 end if; | |
374 | |
375 Index1 := Index2 + 1; | |
376 Find_Colon (Index2); | |
377 | |
378 if Info.Kind = C then | |
379 Info.Constant_Type := Field_Alloc; | |
380 | |
381 if Info.Constant_Type'Length > Max_Constant_Type_Len then | |
382 Max_Constant_Type_Len := Info.Constant_Type'Length; | |
383 end if; | |
384 | |
385 Index1 := Index2 + 1; | |
386 Find_Colon (Index2); | |
387 end if; | |
388 | |
389 if Info.Kind = CND or else Info.Kind = CNU then | |
390 Info.Int_Value := | |
391 Parse_Int (Line (Index1 .. Index2 - 1), Info.Kind); | |
392 Info.Value_Len := Info.Int_Value.Abs_Value'Img'Length - 1; | |
393 | |
394 if not Info.Int_Value.Positive then | |
395 Info.Value_Len := Info.Value_Len + 1; | |
396 end if; | |
397 | |
398 else | |
399 Info.Text_Value := Field_Alloc; | |
400 Info.Value_Len := Info.Text_Value'Length; | |
401 end if; | |
402 | |
403 if Info.Constant_Name.all = "SIZEOF_unsigned_int" then | |
404 Size_Of_Unsigned_Int := | |
405 8 * Integer (Info.Int_Value.Abs_Value); | |
406 end if; | |
407 | |
408 when others => | |
409 null; | |
410 end case; | |
411 | |
412 Index1 := Index2 + 1; | |
413 Index2 := Line'Last + 1; | |
414 Info.Comment := Field_Alloc; | |
415 | |
416 if Info.Kind = TXT then | |
417 Info.Text_Value := Info.Comment; | |
418 | |
419 -- Update Max_Constant_Value_Len, but only if this constant has a | |
420 -- comment (else the value is allowed to be longer). | |
421 | |
422 elsif Info.Comment'Length > 0 then | |
423 if Info.Value_Len > Max_Constant_Value_Len then | |
424 Max_Constant_Value_Len := Info.Value_Len; | |
425 end if; | |
426 end if; | |
427 | |
428 Asm_Infos.Append (Info); | |
429 end; | |
430 | |
431 exception | |
432 when E : others => | |
433 Put_Line | |
434 (Standard_Error, "can't parse " & Line); | |
435 Put_Line | |
436 (Standard_Error, "exception raised: " & Exception_Information (E)); | |
437 end Parse_Asm_Line; | |
438 | |
439 ---------------- | |
440 -- Parse_Cond -- | |
441 ---------------- | |
442 | |
443 procedure Parse_Cond | |
444 (If_Line : String; | |
445 Cond : Boolean; | |
446 Tmpl_File : Ada.Text_IO.File_Type; | |
447 Ada_Ofile, C_Ofile : Sfile; | |
448 Current_Line : in out Integer) | |
449 is | |
450 function Get_Value (Name : String) return Int_Value_Type; | |
451 -- Returns the value of the variable Name | |
452 | |
453 --------------- | |
454 -- Get_Value -- | |
455 --------------- | |
456 | |
457 function Get_Value (Name : String) return Int_Value_Type is | |
458 begin | |
459 if Is_Subset (To_Set (Name), Decimal_Digit_Set) then | |
460 return Parse_Int (Name, CND); | |
461 | |
462 else | |
463 for K in 1 .. Asm_Infos.Last loop | |
464 if Asm_Infos.Table (K).Constant_Name /= null then | |
465 if Name = Asm_Infos.Table (K).Constant_Name.all then | |
466 return Asm_Infos.Table (K).Int_Value; | |
467 end if; | |
468 end if; | |
469 end loop; | |
470 | |
471 -- Not found returns 0 | |
472 | |
473 return (True, 0); | |
474 end if; | |
475 end Get_Value; | |
476 | |
477 -- Local variables | |
478 | |
479 Sline : Slice_Set; | |
480 Line : String (1 .. 256); | |
481 Last : Integer; | |
482 Value1 : Int_Value_Type; | |
483 Value2 : Int_Value_Type; | |
484 Res : Boolean; | |
485 | |
486 -- Start of processing for Parse_Cond | |
487 | |
488 begin | |
489 Create (Sline, If_Line, " "); | |
490 | |
491 if Slice_Count (Sline) /= 4 then | |
492 Put_Line (Standard_Error, "can't parse " & If_Line); | |
493 end if; | |
494 | |
495 Value1 := Get_Value (Slice (Sline, 2)); | |
496 Value2 := Get_Value (Slice (Sline, 4)); | |
497 | |
498 if Slice (Sline, 3) = ">" then | |
499 Res := Cond and (Value1 > Value2); | |
500 | |
501 elsif Slice (Sline, 3) = "<" then | |
502 Res := Cond and (Value1 < Value2); | |
503 | |
504 elsif Slice (Sline, 3) = "=" then | |
505 Res := Cond and (Value1 = Value2); | |
506 | |
507 elsif Slice (Sline, 3) = "/=" then | |
508 Res := Cond and (Value1 /= Value2); | |
509 | |
510 else | |
511 -- No other operator can be used | |
512 | |
513 Put_Line (Standard_Error, "unknown operator in " & If_Line); | |
514 Res := False; | |
515 end if; | |
516 | |
517 Current_Line := Current_Line + 1; | |
518 | |
519 loop | |
520 Get_Line (Tmpl_File, Line, Last); | |
521 Current_Line := Current_Line + 1; | |
522 exit when Line (1 .. Last) = "@END_IF"; | |
523 | |
524 if Last > 4 and then Line (1 .. 4) = "@IF " then | |
525 Parse_Cond | |
526 (Line (1 .. Last), Res, | |
527 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); | |
528 | |
529 elsif Line (1 .. Last) = "@ELSE" then | |
530 Res := Cond and not Res; | |
531 | |
532 elsif Res then | |
533 Put_Line (Ada_OFile, Line (1 .. Last)); | |
534 Put_Line (C_OFile, Line (1 .. Last)); | |
535 end if; | |
536 end loop; | |
537 end Parse_Cond; | |
538 | |
539 --------------- | |
540 -- Parse_Int -- | |
541 --------------- | |
542 | |
543 function Parse_Int | |
544 (S : String; | |
545 K : Asm_Int_Kind) return Int_Value_Type | |
546 is | |
547 First : Integer := S'First; | |
548 Result : Int_Value_Type; | |
549 | |
550 begin | |
551 -- On some platforms, immediate integer values are prefixed with | |
552 -- a $ or # character in assembly output. | |
553 | |
554 if S (First) = '$' or else S (First) = '#' then | |
555 First := First + 1; | |
556 end if; | |
557 | |
558 if S (First) = '-' then | |
559 Result.Positive := False; | |
560 First := First + 1; | |
561 else | |
562 Result.Positive := True; | |
563 end if; | |
564 | |
565 Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last)); | |
566 | |
567 if not Result.Positive and then K = CNU then | |
568 | |
569 -- Negative value, but unsigned expected: take 2's complement | |
570 -- reciprocical value. | |
571 | |
572 Result.Abs_Value := ((not Result.Abs_Value) + 1) | |
573 and | |
574 (Shift_Left (1, Size_Of_Unsigned_Int) - 1); | |
575 Result.Positive := True; | |
576 end if; | |
577 | |
578 return Result; | |
579 | |
580 exception | |
581 when others => | |
582 Put_Line (Standard_Error, "can't parse decimal value: " & S); | |
583 raise; | |
584 end Parse_Int; | |
585 | |
586 ------------ | |
587 -- Spaces -- | |
588 ------------ | |
589 | |
590 function Spaces (Count : Integer) return String is | |
591 begin | |
592 if Count <= 0 then | |
593 return ""; | |
594 else | |
595 return (1 .. Count => ' '); | |
596 end if; | |
597 end Spaces; | |
598 | |
599 -- Local declarations | |
600 | |
601 -- Input files | |
602 | |
603 Tmpl_File_Name : constant String := Tmpl_Name & ".i"; | |
604 Asm_File_Name : constant String := Tmpl_Name & ".s"; | |
605 | |
606 -- Output files | |
607 | |
608 Ada_File_Name : constant String := Unit_Name & ".ads"; | |
609 C_File_Name : constant String := Unit_Name & ".h"; | |
610 | |
611 Asm_File : Ada.Text_IO.File_Type; | |
612 Tmpl_File : Ada.Text_IO.File_Type; | |
613 Ada_OFile : Sfile; | |
614 C_OFile : Sfile; | |
615 | |
616 Line : String (1 .. 256); | |
617 Last : Integer; | |
618 -- Line being processed | |
619 | |
620 Current_Line : Integer; | |
621 Current_Info : Integer; | |
622 In_Comment : Boolean; | |
623 In_Template : Boolean; | |
624 | |
625 -- Start of processing for XOSCons | |
626 | |
627 begin | |
628 -- Load values from assembly file | |
629 | |
630 Open (Asm_File, In_File, Asm_File_Name); | |
631 while not End_Of_File (Asm_File) loop | |
632 Get_Line (Asm_File, Line, Last); | |
633 if Last > 2 and then Line (1 .. 2) = "->" then | |
634 Parse_Asm_Line (Line (3 .. Last)); | |
635 end if; | |
636 end loop; | |
637 | |
638 Close (Asm_File); | |
639 | |
640 -- Load C template and output definitions | |
641 | |
642 Open (Tmpl_File, In_File, Tmpl_File_Name); | |
643 Create (Ada_OFile, Out_File, Ada_File_Name); | |
644 Create (C_OFile, Out_File, C_File_Name); | |
645 | |
646 Current_Line := 0; | |
647 Current_Info := Asm_Infos.First; | |
648 In_Comment := False; | |
649 | |
650 while not End_Of_File (Tmpl_File) loop | |
651 <<Get_One_Line>> | |
652 Get_Line (Tmpl_File, Line, Last); | |
653 | |
654 if Last >= 2 and then Line (1 .. 2) = "# " then | |
655 declare | |
656 Index : Integer; | |
657 | |
658 begin | |
659 Index := 3; | |
660 while Index <= Last and then Line (Index) in '0' .. '9' loop | |
661 Index := Index + 1; | |
662 end loop; | |
663 | |
664 if Contains_Template_Name (Line (Index + 1 .. Last)) then | |
665 Current_Line := Integer'Value (Line (3 .. Index - 1)); | |
666 In_Template := True; | |
667 goto Get_One_Line; | |
668 else | |
669 In_Template := False; | |
670 end if; | |
671 end; | |
672 | |
673 elsif In_Template then | |
674 if In_Comment then | |
675 if Line (1 .. Last) = "*/" then | |
676 Put_Line (C_OFile, Line (1 .. Last)); | |
677 In_Comment := False; | |
678 | |
679 elsif Last > 4 and then Line (1 .. 4) = "@IF " then | |
680 Parse_Cond | |
681 (Line (1 .. Last), True, | |
682 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); | |
683 | |
684 else | |
685 Put_Line (Ada_OFile, Line (1 .. Last)); | |
686 Put_Line (C_OFile, Line (1 .. Last)); | |
687 end if; | |
688 | |
689 elsif Line (1 .. Last) = "/*" then | |
690 Put_Line (C_OFile, Line (1 .. Last)); | |
691 In_Comment := True; | |
692 | |
693 elsif Asm_Infos.Table (Current_Info).Line_Number = Current_Line then | |
694 if Fixed.Index (Line, "/*NOGEN*/") = 0 then | |
695 Output_Info (Lang_Ada, Ada_OFile, Current_Info); | |
696 Output_Info (Lang_C, C_OFile, Current_Info); | |
697 end if; | |
698 | |
699 Current_Info := Current_Info + 1; | |
700 end if; | |
701 | |
702 Current_Line := Current_Line + 1; | |
703 end if; | |
704 end loop; | |
705 | |
706 Close (Tmpl_File); | |
707 | |
708 exception | |
709 when E : others => | |
710 Put_Line ("raised " & Ada.Exceptions.Exception_Information (E)); | |
711 GNAT.OS_Lib.OS_Exit (1); | |
712 end XOSCons; |