annotate gcc/ada/xoscons.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
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 -- --
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
9 -- Copyright (C) 2008-2019, 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
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
232 & " is " & Info.Text_Value.all & ";");
111
kono
parents:
diff changeset
233 when Lang_C =>
kono
parents:
diff changeset
234 Put ("#define " & Info.Constant_Name.all & " "
kono
parents:
diff changeset
235 & Info.Text_Value.all);
kono
parents:
diff changeset
236 end case;
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 when others =>
kono
parents:
diff changeset
239
kono
parents:
diff changeset
240 -- All named number cases
kono
parents:
diff changeset
241
kono
parents:
diff changeset
242 case Lang is
kono
parents:
diff changeset
243 when Lang_Ada =>
kono
parents:
diff changeset
244 Put (" " & Info.Constant_Name.all);
kono
parents:
diff changeset
245 Put (Spaces (Max_Constant_Name_Len
kono
parents:
diff changeset
246 - Info.Constant_Name'Length));
kono
parents:
diff changeset
247
kono
parents:
diff changeset
248 if Info.Kind in Named_Number then
kono
parents:
diff changeset
249 Put (" : constant := ");
kono
parents:
diff changeset
250 else
kono
parents:
diff changeset
251 Put (" : constant " & Info.Constant_Type.all);
kono
parents:
diff changeset
252 Put (Spaces (Max_Constant_Type_Len
kono
parents:
diff changeset
253 - Info.Constant_Type'Length));
kono
parents:
diff changeset
254 Put (" := ");
kono
parents:
diff changeset
255 end if;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 when Lang_C =>
kono
parents:
diff changeset
258 Put ("#define " & Info.Constant_Name.all & " ");
kono
parents:
diff changeset
259 Put (Spaces (Max_Constant_Name_Len
kono
parents:
diff changeset
260 - Info.Constant_Name'Length));
kono
parents:
diff changeset
261 end case;
kono
parents:
diff changeset
262
kono
parents:
diff changeset
263 if Info.Kind in Asm_Int_Kind then
kono
parents:
diff changeset
264 if not Info.Int_Value.Positive then
kono
parents:
diff changeset
265 Put ("-");
kono
parents:
diff changeset
266 end if;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
kono
parents:
diff changeset
269
kono
parents:
diff changeset
270 else
kono
parents:
diff changeset
271 declare
kono
parents:
diff changeset
272 Is_String : constant Boolean :=
kono
parents:
diff changeset
273 Info.Kind = C
kono
parents:
diff changeset
274 and then Info.Constant_Type.all = "String";
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 begin
kono
parents:
diff changeset
277 if Is_String then
kono
parents:
diff changeset
278 Put ("""");
kono
parents:
diff changeset
279 end if;
kono
parents:
diff changeset
280
kono
parents:
diff changeset
281 Put (Info.Text_Value.all);
kono
parents:
diff changeset
282
kono
parents:
diff changeset
283 if Is_String then
kono
parents:
diff changeset
284 Put ("""");
kono
parents:
diff changeset
285 end if;
kono
parents:
diff changeset
286 end;
kono
parents:
diff changeset
287 end if;
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 if Lang = Lang_Ada then
kono
parents:
diff changeset
290 Put (";");
kono
parents:
diff changeset
291
kono
parents:
diff changeset
292 if Info.Comment'Length > 0 then
kono
parents:
diff changeset
293 Put (Spaces (Max_Constant_Value_Len - Info.Value_Len));
kono
parents:
diff changeset
294 Put (" -- ");
kono
parents:
diff changeset
295 end if;
kono
parents:
diff changeset
296 end if;
kono
parents:
diff changeset
297 end case;
kono
parents:
diff changeset
298
kono
parents:
diff changeset
299 if Lang = Lang_Ada then
kono
parents:
diff changeset
300 Put (Info.Comment.all);
kono
parents:
diff changeset
301 end if;
kono
parents:
diff changeset
302
kono
parents:
diff changeset
303 New_Line (OFile);
kono
parents:
diff changeset
304 end Output_Info;
kono
parents:
diff changeset
305
kono
parents:
diff changeset
306 --------------------
kono
parents:
diff changeset
307 -- Parse_Asm_Line --
kono
parents:
diff changeset
308 --------------------
kono
parents:
diff changeset
309
kono
parents:
diff changeset
310 procedure Parse_Asm_Line (Line : String) is
kono
parents:
diff changeset
311 Index1, Index2 : Integer := Line'First;
kono
parents:
diff changeset
312
kono
parents:
diff changeset
313 function Field_Alloc return String_Access;
kono
parents:
diff changeset
314 -- Allocate and return a copy of Line (Index1 .. Index2 - 1)
kono
parents:
diff changeset
315
kono
parents:
diff changeset
316 procedure Find_Colon (Index : in out Integer);
kono
parents:
diff changeset
317 -- Increment Index until the next colon in Line
kono
parents:
diff changeset
318
kono
parents:
diff changeset
319 -----------------
kono
parents:
diff changeset
320 -- Field_Alloc --
kono
parents:
diff changeset
321 -----------------
kono
parents:
diff changeset
322
kono
parents:
diff changeset
323 function Field_Alloc return String_Access is
kono
parents:
diff changeset
324 begin
kono
parents:
diff changeset
325 return new String'(Line (Index1 .. Index2 - 1));
kono
parents:
diff changeset
326 end Field_Alloc;
kono
parents:
diff changeset
327
kono
parents:
diff changeset
328 ----------------
kono
parents:
diff changeset
329 -- Find_Colon --
kono
parents:
diff changeset
330 ----------------
kono
parents:
diff changeset
331
kono
parents:
diff changeset
332 procedure Find_Colon (Index : in out Integer) is
kono
parents:
diff changeset
333 begin
kono
parents:
diff changeset
334 loop
kono
parents:
diff changeset
335 Index := Index + 1;
kono
parents:
diff changeset
336 exit when Index > Line'Last or else Line (Index) = ':';
kono
parents:
diff changeset
337 end loop;
kono
parents:
diff changeset
338 end Find_Colon;
kono
parents:
diff changeset
339
kono
parents:
diff changeset
340 -- Start of processing for Parse_Asm_Line
kono
parents:
diff changeset
341
kono
parents:
diff changeset
342 begin
kono
parents:
diff changeset
343 Find_Colon (Index2);
kono
parents:
diff changeset
344
kono
parents:
diff changeset
345 declare
kono
parents:
diff changeset
346 Info : Asm_Info (Kind => Asm_Info_Kind'Value
kono
parents:
diff changeset
347 (Line (Line'First .. Index2 - 1)));
kono
parents:
diff changeset
348 begin
kono
parents:
diff changeset
349 Index1 := Index2 + 1;
kono
parents:
diff changeset
350 Find_Colon (Index2);
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 Info.Line_Number :=
kono
parents:
diff changeset
353 Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value);
kono
parents:
diff changeset
354
kono
parents:
diff changeset
355 case Info.Kind is
kono
parents:
diff changeset
356 when C
kono
parents:
diff changeset
357 | CND
kono
parents:
diff changeset
358 | CNS
kono
parents:
diff changeset
359 | CNU
kono
parents:
diff changeset
360 | SUB
kono
parents:
diff changeset
361 =>
kono
parents:
diff changeset
362 Index1 := Index2 + 1;
kono
parents:
diff changeset
363 Find_Colon (Index2);
kono
parents:
diff changeset
364
kono
parents:
diff changeset
365 Info.Constant_Name := Field_Alloc;
kono
parents:
diff changeset
366
kono
parents:
diff changeset
367 if Info.Kind /= SUB
kono
parents:
diff changeset
368 and then
kono
parents:
diff changeset
369 Info.Constant_Name'Length > Max_Constant_Name_Len
kono
parents:
diff changeset
370 then
kono
parents:
diff changeset
371 Max_Constant_Name_Len := Info.Constant_Name'Length;
kono
parents:
diff changeset
372 end if;
kono
parents:
diff changeset
373
kono
parents:
diff changeset
374 Index1 := Index2 + 1;
kono
parents:
diff changeset
375 Find_Colon (Index2);
kono
parents:
diff changeset
376
kono
parents:
diff changeset
377 if Info.Kind = C then
kono
parents:
diff changeset
378 Info.Constant_Type := Field_Alloc;
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 if Info.Constant_Type'Length > Max_Constant_Type_Len then
kono
parents:
diff changeset
381 Max_Constant_Type_Len := Info.Constant_Type'Length;
kono
parents:
diff changeset
382 end if;
kono
parents:
diff changeset
383
kono
parents:
diff changeset
384 Index1 := Index2 + 1;
kono
parents:
diff changeset
385 Find_Colon (Index2);
kono
parents:
diff changeset
386 end if;
kono
parents:
diff changeset
387
kono
parents:
diff changeset
388 if Info.Kind = CND or else Info.Kind = CNU then
kono
parents:
diff changeset
389 Info.Int_Value :=
kono
parents:
diff changeset
390 Parse_Int (Line (Index1 .. Index2 - 1), Info.Kind);
kono
parents:
diff changeset
391 Info.Value_Len := Info.Int_Value.Abs_Value'Img'Length - 1;
kono
parents:
diff changeset
392
kono
parents:
diff changeset
393 if not Info.Int_Value.Positive then
kono
parents:
diff changeset
394 Info.Value_Len := Info.Value_Len + 1;
kono
parents:
diff changeset
395 end if;
kono
parents:
diff changeset
396
kono
parents:
diff changeset
397 else
kono
parents:
diff changeset
398 Info.Text_Value := Field_Alloc;
kono
parents:
diff changeset
399 Info.Value_Len := Info.Text_Value'Length;
kono
parents:
diff changeset
400 end if;
kono
parents:
diff changeset
401
kono
parents:
diff changeset
402 if Info.Constant_Name.all = "SIZEOF_unsigned_int" then
kono
parents:
diff changeset
403 Size_Of_Unsigned_Int :=
kono
parents:
diff changeset
404 8 * Integer (Info.Int_Value.Abs_Value);
kono
parents:
diff changeset
405 end if;
kono
parents:
diff changeset
406
kono
parents:
diff changeset
407 when others =>
kono
parents:
diff changeset
408 null;
kono
parents:
diff changeset
409 end case;
kono
parents:
diff changeset
410
kono
parents:
diff changeset
411 Index1 := Index2 + 1;
kono
parents:
diff changeset
412 Index2 := Line'Last + 1;
kono
parents:
diff changeset
413 Info.Comment := Field_Alloc;
kono
parents:
diff changeset
414
kono
parents:
diff changeset
415 if Info.Kind = TXT then
kono
parents:
diff changeset
416 Info.Text_Value := Info.Comment;
kono
parents:
diff changeset
417
kono
parents:
diff changeset
418 -- Update Max_Constant_Value_Len, but only if this constant has a
kono
parents:
diff changeset
419 -- comment (else the value is allowed to be longer).
kono
parents:
diff changeset
420
kono
parents:
diff changeset
421 elsif Info.Comment'Length > 0 then
kono
parents:
diff changeset
422 if Info.Value_Len > Max_Constant_Value_Len then
kono
parents:
diff changeset
423 Max_Constant_Value_Len := Info.Value_Len;
kono
parents:
diff changeset
424 end if;
kono
parents:
diff changeset
425 end if;
kono
parents:
diff changeset
426
kono
parents:
diff changeset
427 Asm_Infos.Append (Info);
kono
parents:
diff changeset
428 end;
kono
parents:
diff changeset
429
kono
parents:
diff changeset
430 exception
kono
parents:
diff changeset
431 when E : others =>
kono
parents:
diff changeset
432 Put_Line
kono
parents:
diff changeset
433 (Standard_Error, "can't parse " & Line);
kono
parents:
diff changeset
434 Put_Line
kono
parents:
diff changeset
435 (Standard_Error, "exception raised: " & Exception_Information (E));
kono
parents:
diff changeset
436 end Parse_Asm_Line;
kono
parents:
diff changeset
437
kono
parents:
diff changeset
438 ----------------
kono
parents:
diff changeset
439 -- Parse_Cond --
kono
parents:
diff changeset
440 ----------------
kono
parents:
diff changeset
441
kono
parents:
diff changeset
442 procedure Parse_Cond
kono
parents:
diff changeset
443 (If_Line : String;
kono
parents:
diff changeset
444 Cond : Boolean;
kono
parents:
diff changeset
445 Tmpl_File : Ada.Text_IO.File_Type;
kono
parents:
diff changeset
446 Ada_Ofile, C_Ofile : Sfile;
kono
parents:
diff changeset
447 Current_Line : in out Integer)
kono
parents:
diff changeset
448 is
kono
parents:
diff changeset
449 function Get_Value (Name : String) return Int_Value_Type;
kono
parents:
diff changeset
450 -- Returns the value of the variable Name
kono
parents:
diff changeset
451
kono
parents:
diff changeset
452 ---------------
kono
parents:
diff changeset
453 -- Get_Value --
kono
parents:
diff changeset
454 ---------------
kono
parents:
diff changeset
455
kono
parents:
diff changeset
456 function Get_Value (Name : String) return Int_Value_Type is
kono
parents:
diff changeset
457 begin
kono
parents:
diff changeset
458 if Is_Subset (To_Set (Name), Decimal_Digit_Set) then
kono
parents:
diff changeset
459 return Parse_Int (Name, CND);
kono
parents:
diff changeset
460
kono
parents:
diff changeset
461 else
kono
parents:
diff changeset
462 for K in 1 .. Asm_Infos.Last loop
kono
parents:
diff changeset
463 if Asm_Infos.Table (K).Constant_Name /= null then
kono
parents:
diff changeset
464 if Name = Asm_Infos.Table (K).Constant_Name.all then
kono
parents:
diff changeset
465 return Asm_Infos.Table (K).Int_Value;
kono
parents:
diff changeset
466 end if;
kono
parents:
diff changeset
467 end if;
kono
parents:
diff changeset
468 end loop;
kono
parents:
diff changeset
469
kono
parents:
diff changeset
470 -- Not found returns 0
kono
parents:
diff changeset
471
kono
parents:
diff changeset
472 return (True, 0);
kono
parents:
diff changeset
473 end if;
kono
parents:
diff changeset
474 end Get_Value;
kono
parents:
diff changeset
475
kono
parents:
diff changeset
476 -- Local variables
kono
parents:
diff changeset
477
kono
parents:
diff changeset
478 Sline : Slice_Set;
kono
parents:
diff changeset
479 Line : String (1 .. 256);
kono
parents:
diff changeset
480 Last : Integer;
kono
parents:
diff changeset
481 Value1 : Int_Value_Type;
kono
parents:
diff changeset
482 Value2 : Int_Value_Type;
kono
parents:
diff changeset
483 Res : Boolean;
kono
parents:
diff changeset
484
kono
parents:
diff changeset
485 -- Start of processing for Parse_Cond
kono
parents:
diff changeset
486
kono
parents:
diff changeset
487 begin
kono
parents:
diff changeset
488 Create (Sline, If_Line, " ");
kono
parents:
diff changeset
489
kono
parents:
diff changeset
490 if Slice_Count (Sline) /= 4 then
kono
parents:
diff changeset
491 Put_Line (Standard_Error, "can't parse " & If_Line);
kono
parents:
diff changeset
492 end if;
kono
parents:
diff changeset
493
kono
parents:
diff changeset
494 Value1 := Get_Value (Slice (Sline, 2));
kono
parents:
diff changeset
495 Value2 := Get_Value (Slice (Sline, 4));
kono
parents:
diff changeset
496
kono
parents:
diff changeset
497 if Slice (Sline, 3) = ">" then
kono
parents:
diff changeset
498 Res := Cond and (Value1 > Value2);
kono
parents:
diff changeset
499
kono
parents:
diff changeset
500 elsif Slice (Sline, 3) = "<" then
kono
parents:
diff changeset
501 Res := Cond and (Value1 < Value2);
kono
parents:
diff changeset
502
kono
parents:
diff changeset
503 elsif Slice (Sline, 3) = "=" then
kono
parents:
diff changeset
504 Res := Cond and (Value1 = Value2);
kono
parents:
diff changeset
505
kono
parents:
diff changeset
506 elsif Slice (Sline, 3) = "/=" then
kono
parents:
diff changeset
507 Res := Cond and (Value1 /= Value2);
kono
parents:
diff changeset
508
kono
parents:
diff changeset
509 else
kono
parents:
diff changeset
510 -- No other operator can be used
kono
parents:
diff changeset
511
kono
parents:
diff changeset
512 Put_Line (Standard_Error, "unknown operator in " & If_Line);
kono
parents:
diff changeset
513 Res := False;
kono
parents:
diff changeset
514 end if;
kono
parents:
diff changeset
515
kono
parents:
diff changeset
516 Current_Line := Current_Line + 1;
kono
parents:
diff changeset
517
kono
parents:
diff changeset
518 loop
kono
parents:
diff changeset
519 Get_Line (Tmpl_File, Line, Last);
kono
parents:
diff changeset
520 Current_Line := Current_Line + 1;
kono
parents:
diff changeset
521 exit when Line (1 .. Last) = "@END_IF";
kono
parents:
diff changeset
522
kono
parents:
diff changeset
523 if Last > 4 and then Line (1 .. 4) = "@IF " then
kono
parents:
diff changeset
524 Parse_Cond
kono
parents:
diff changeset
525 (Line (1 .. Last), Res,
kono
parents:
diff changeset
526 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line);
kono
parents:
diff changeset
527
kono
parents:
diff changeset
528 elsif Line (1 .. Last) = "@ELSE" then
kono
parents:
diff changeset
529 Res := Cond and not Res;
kono
parents:
diff changeset
530
kono
parents:
diff changeset
531 elsif Res then
kono
parents:
diff changeset
532 Put_Line (Ada_OFile, Line (1 .. Last));
kono
parents:
diff changeset
533 Put_Line (C_OFile, Line (1 .. Last));
kono
parents:
diff changeset
534 end if;
kono
parents:
diff changeset
535 end loop;
kono
parents:
diff changeset
536 end Parse_Cond;
kono
parents:
diff changeset
537
kono
parents:
diff changeset
538 ---------------
kono
parents:
diff changeset
539 -- Parse_Int --
kono
parents:
diff changeset
540 ---------------
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 function Parse_Int
kono
parents:
diff changeset
543 (S : String;
kono
parents:
diff changeset
544 K : Asm_Int_Kind) return Int_Value_Type
kono
parents:
diff changeset
545 is
kono
parents:
diff changeset
546 First : Integer := S'First;
kono
parents:
diff changeset
547 Result : Int_Value_Type;
kono
parents:
diff changeset
548
kono
parents:
diff changeset
549 begin
kono
parents:
diff changeset
550 -- On some platforms, immediate integer values are prefixed with
kono
parents:
diff changeset
551 -- a $ or # character in assembly output.
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 if S (First) = '$' or else S (First) = '#' then
kono
parents:
diff changeset
554 First := First + 1;
kono
parents:
diff changeset
555 end if;
kono
parents:
diff changeset
556
kono
parents:
diff changeset
557 if S (First) = '-' then
kono
parents:
diff changeset
558 Result.Positive := False;
kono
parents:
diff changeset
559 First := First + 1;
kono
parents:
diff changeset
560 else
kono
parents:
diff changeset
561 Result.Positive := True;
kono
parents:
diff changeset
562 end if;
kono
parents:
diff changeset
563
kono
parents:
diff changeset
564 Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last));
kono
parents:
diff changeset
565
kono
parents:
diff changeset
566 if not Result.Positive and then K = CNU then
kono
parents:
diff changeset
567
kono
parents:
diff changeset
568 -- Negative value, but unsigned expected: take 2's complement
kono
parents:
diff changeset
569 -- reciprocical value.
kono
parents:
diff changeset
570
kono
parents:
diff changeset
571 Result.Abs_Value := ((not Result.Abs_Value) + 1)
kono
parents:
diff changeset
572 and
kono
parents:
diff changeset
573 (Shift_Left (1, Size_Of_Unsigned_Int) - 1);
kono
parents:
diff changeset
574 Result.Positive := True;
kono
parents:
diff changeset
575 end if;
kono
parents:
diff changeset
576
kono
parents:
diff changeset
577 return Result;
kono
parents:
diff changeset
578
kono
parents:
diff changeset
579 exception
kono
parents:
diff changeset
580 when others =>
kono
parents:
diff changeset
581 Put_Line (Standard_Error, "can't parse decimal value: " & S);
kono
parents:
diff changeset
582 raise;
kono
parents:
diff changeset
583 end Parse_Int;
kono
parents:
diff changeset
584
kono
parents:
diff changeset
585 ------------
kono
parents:
diff changeset
586 -- Spaces --
kono
parents:
diff changeset
587 ------------
kono
parents:
diff changeset
588
kono
parents:
diff changeset
589 function Spaces (Count : Integer) return String is
kono
parents:
diff changeset
590 begin
kono
parents:
diff changeset
591 if Count <= 0 then
kono
parents:
diff changeset
592 return "";
kono
parents:
diff changeset
593 else
kono
parents:
diff changeset
594 return (1 .. Count => ' ');
kono
parents:
diff changeset
595 end if;
kono
parents:
diff changeset
596 end Spaces;
kono
parents:
diff changeset
597
kono
parents:
diff changeset
598 -- Local declarations
kono
parents:
diff changeset
599
kono
parents:
diff changeset
600 -- Input files
kono
parents:
diff changeset
601
kono
parents:
diff changeset
602 Tmpl_File_Name : constant String := Tmpl_Name & ".i";
kono
parents:
diff changeset
603 Asm_File_Name : constant String := Tmpl_Name & ".s";
kono
parents:
diff changeset
604
kono
parents:
diff changeset
605 -- Output files
kono
parents:
diff changeset
606
kono
parents:
diff changeset
607 Ada_File_Name : constant String := Unit_Name & ".ads";
kono
parents:
diff changeset
608 C_File_Name : constant String := Unit_Name & ".h";
kono
parents:
diff changeset
609
kono
parents:
diff changeset
610 Asm_File : Ada.Text_IO.File_Type;
kono
parents:
diff changeset
611 Tmpl_File : Ada.Text_IO.File_Type;
kono
parents:
diff changeset
612 Ada_OFile : Sfile;
kono
parents:
diff changeset
613 C_OFile : Sfile;
kono
parents:
diff changeset
614
kono
parents:
diff changeset
615 Line : String (1 .. 256);
kono
parents:
diff changeset
616 Last : Integer;
kono
parents:
diff changeset
617 -- Line being processed
kono
parents:
diff changeset
618
kono
parents:
diff changeset
619 Current_Line : Integer;
kono
parents:
diff changeset
620 Current_Info : Integer;
kono
parents:
diff changeset
621 In_Comment : Boolean;
kono
parents:
diff changeset
622 In_Template : Boolean;
kono
parents:
diff changeset
623
kono
parents:
diff changeset
624 -- Start of processing for XOSCons
kono
parents:
diff changeset
625
kono
parents:
diff changeset
626 begin
kono
parents:
diff changeset
627 -- Load values from assembly file
kono
parents:
diff changeset
628
kono
parents:
diff changeset
629 Open (Asm_File, In_File, Asm_File_Name);
kono
parents:
diff changeset
630 while not End_Of_File (Asm_File) loop
kono
parents:
diff changeset
631 Get_Line (Asm_File, Line, Last);
kono
parents:
diff changeset
632 if Last > 2 and then Line (1 .. 2) = "->" then
kono
parents:
diff changeset
633 Parse_Asm_Line (Line (3 .. Last));
kono
parents:
diff changeset
634 end if;
kono
parents:
diff changeset
635 end loop;
kono
parents:
diff changeset
636
kono
parents:
diff changeset
637 Close (Asm_File);
kono
parents:
diff changeset
638
kono
parents:
diff changeset
639 -- Load C template and output definitions
kono
parents:
diff changeset
640
kono
parents:
diff changeset
641 Open (Tmpl_File, In_File, Tmpl_File_Name);
kono
parents:
diff changeset
642 Create (Ada_OFile, Out_File, Ada_File_Name);
kono
parents:
diff changeset
643 Create (C_OFile, Out_File, C_File_Name);
kono
parents:
diff changeset
644
kono
parents:
diff changeset
645 Current_Line := 0;
kono
parents:
diff changeset
646 Current_Info := Asm_Infos.First;
kono
parents:
diff changeset
647 In_Comment := False;
kono
parents:
diff changeset
648
kono
parents:
diff changeset
649 while not End_Of_File (Tmpl_File) loop
kono
parents:
diff changeset
650 <<Get_One_Line>>
kono
parents:
diff changeset
651 Get_Line (Tmpl_File, Line, Last);
kono
parents:
diff changeset
652
kono
parents:
diff changeset
653 if Last >= 2 and then Line (1 .. 2) = "# " then
kono
parents:
diff changeset
654 declare
kono
parents:
diff changeset
655 Index : Integer;
kono
parents:
diff changeset
656
kono
parents:
diff changeset
657 begin
kono
parents:
diff changeset
658 Index := 3;
kono
parents:
diff changeset
659 while Index <= Last and then Line (Index) in '0' .. '9' loop
kono
parents:
diff changeset
660 Index := Index + 1;
kono
parents:
diff changeset
661 end loop;
kono
parents:
diff changeset
662
kono
parents:
diff changeset
663 if Contains_Template_Name (Line (Index + 1 .. Last)) then
kono
parents:
diff changeset
664 Current_Line := Integer'Value (Line (3 .. Index - 1));
kono
parents:
diff changeset
665 In_Template := True;
kono
parents:
diff changeset
666 goto Get_One_Line;
kono
parents:
diff changeset
667 else
kono
parents:
diff changeset
668 In_Template := False;
kono
parents:
diff changeset
669 end if;
kono
parents:
diff changeset
670 end;
kono
parents:
diff changeset
671
kono
parents:
diff changeset
672 elsif In_Template then
kono
parents:
diff changeset
673 if In_Comment then
kono
parents:
diff changeset
674 if Line (1 .. Last) = "*/" then
kono
parents:
diff changeset
675 Put_Line (C_OFile, Line (1 .. Last));
kono
parents:
diff changeset
676 In_Comment := False;
kono
parents:
diff changeset
677
kono
parents:
diff changeset
678 elsif Last > 4 and then Line (1 .. 4) = "@IF " then
kono
parents:
diff changeset
679 Parse_Cond
kono
parents:
diff changeset
680 (Line (1 .. Last), True,
kono
parents:
diff changeset
681 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line);
kono
parents:
diff changeset
682
kono
parents:
diff changeset
683 else
kono
parents:
diff changeset
684 Put_Line (Ada_OFile, Line (1 .. Last));
kono
parents:
diff changeset
685 Put_Line (C_OFile, Line (1 .. Last));
kono
parents:
diff changeset
686 end if;
kono
parents:
diff changeset
687
kono
parents:
diff changeset
688 elsif Line (1 .. Last) = "/*" then
kono
parents:
diff changeset
689 Put_Line (C_OFile, Line (1 .. Last));
kono
parents:
diff changeset
690 In_Comment := True;
kono
parents:
diff changeset
691
kono
parents:
diff changeset
692 elsif Asm_Infos.Table (Current_Info).Line_Number = Current_Line then
kono
parents:
diff changeset
693 if Fixed.Index (Line, "/*NOGEN*/") = 0 then
kono
parents:
diff changeset
694 Output_Info (Lang_Ada, Ada_OFile, Current_Info);
kono
parents:
diff changeset
695 Output_Info (Lang_C, C_OFile, Current_Info);
kono
parents:
diff changeset
696 end if;
kono
parents:
diff changeset
697
kono
parents:
diff changeset
698 Current_Info := Current_Info + 1;
kono
parents:
diff changeset
699 end if;
kono
parents:
diff changeset
700
kono
parents:
diff changeset
701 Current_Line := Current_Line + 1;
kono
parents:
diff changeset
702 end if;
kono
parents:
diff changeset
703 end loop;
kono
parents:
diff changeset
704
kono
parents:
diff changeset
705 Close (Tmpl_File);
kono
parents:
diff changeset
706
kono
parents:
diff changeset
707 exception
kono
parents:
diff changeset
708 when E : others =>
kono
parents:
diff changeset
709 Put_Line ("raised " & Ada.Exceptions.Exception_Information (E));
kono
parents:
diff changeset
710 GNAT.OS_Lib.OS_Exit (1);
kono
parents:
diff changeset
711 end XOSCons;