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