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