annotate gcc/ada/xoscons.adb @ 131:84e7813d76e9

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