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-2020, 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 " & 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 C 357 | CND 358 | CNS 359 | CNU 360 | SUB 361 => 362 Index1 := Index2 + 1; 363 Find_Colon (Index2); 364 365 Info.Constant_Name := Field_Alloc; 366 367 if Info.Kind /= SUB 368 and then 369 Info.Constant_Name'Length > Max_Constant_Name_Len 370 then 371 Max_Constant_Name_Len := Info.Constant_Name'Length; 372 end if; 373 374 Index1 := Index2 + 1; 375 Find_Colon (Index2); 376 377 if Info.Kind = C then 378 Info.Constant_Type := Field_Alloc; 379 380 if Info.Constant_Type'Length > Max_Constant_Type_Len then 381 Max_Constant_Type_Len := Info.Constant_Type'Length; 382 end if; 383 384 Index1 := Index2 + 1; 385 Find_Colon (Index2); 386 end if; 387 388 if Info.Kind = CND or else Info.Kind = CNU then 389 Info.Int_Value := 390 Parse_Int (Line (Index1 .. Index2 - 1), Info.Kind); 391 Info.Value_Len := Info.Int_Value.Abs_Value'Img'Length - 1; 392 393 if not Info.Int_Value.Positive then 394 Info.Value_Len := Info.Value_Len + 1; 395 end if; 396 397 else 398 Info.Text_Value := Field_Alloc; 399 Info.Value_Len := Info.Text_Value'Length; 400 end if; 401 402 if Info.Constant_Name.all = "SIZEOF_unsigned_int" then 403 Size_Of_Unsigned_Int := 404 8 * Integer (Info.Int_Value.Abs_Value); 405 end if; 406 407 when others => 408 null; 409 end case; 410 411 Index1 := Index2 + 1; 412 Index2 := Line'Last + 1; 413 Info.Comment := Field_Alloc; 414 415 if Info.Kind = TXT then 416 Info.Text_Value := Info.Comment; 417 418 -- Update Max_Constant_Value_Len, but only if this constant has a 419 -- comment (else the value is allowed to be longer). 420 421 elsif Info.Comment'Length > 0 then 422 if Info.Value_Len > Max_Constant_Value_Len then 423 Max_Constant_Value_Len := Info.Value_Len; 424 end if; 425 end if; 426 427 Asm_Infos.Append (Info); 428 end; 429 430 exception 431 when E : others => 432 Put_Line 433 (Standard_Error, "can't parse " & Line); 434 Put_Line 435 (Standard_Error, "exception raised: " & Exception_Information (E)); 436 end Parse_Asm_Line; 437 438 ---------------- 439 -- Parse_Cond -- 440 ---------------- 441 442 procedure Parse_Cond 443 (If_Line : String; 444 Cond : Boolean; 445 Tmpl_File : Ada.Text_IO.File_Type; 446 Ada_Ofile, C_Ofile : Sfile; 447 Current_Line : in out Integer) 448 is 449 function Get_Value (Name : String) return Int_Value_Type; 450 -- Returns the value of the variable Name 451 452 --------------- 453 -- Get_Value -- 454 --------------- 455 456 function Get_Value (Name : String) return Int_Value_Type is 457 begin 458 if Is_Subset (To_Set (Name), Decimal_Digit_Set) then 459 return Parse_Int (Name, CND); 460 461 else 462 for K in 1 .. Asm_Infos.Last loop 463 if Asm_Infos.Table (K).Constant_Name /= null then 464 if Name = Asm_Infos.Table (K).Constant_Name.all then 465 return Asm_Infos.Table (K).Int_Value; 466 end if; 467 end if; 468 end loop; 469 470 -- Not found returns 0 471 472 return (True, 0); 473 end if; 474 end Get_Value; 475 476 -- Local variables 477 478 Sline : Slice_Set; 479 Line : String (1 .. 256); 480 Last : Integer; 481 Value1 : Int_Value_Type; 482 Value2 : Int_Value_Type; 483 Res : Boolean; 484 485 -- Start of processing for Parse_Cond 486 487 begin 488 Create (Sline, If_Line, " "); 489 490 if Slice_Count (Sline) /= 4 then 491 Put_Line (Standard_Error, "can't parse " & If_Line); 492 end if; 493 494 Value1 := Get_Value (Slice (Sline, 2)); 495 Value2 := Get_Value (Slice (Sline, 4)); 496 497 pragma Annotate (CodePeer, Modified, Value1); 498 pragma Annotate (CodePeer, Modified, Value2); 499 500 if Slice (Sline, 3) = ">" then 501 Res := Cond and (Value1 > Value2); 502 503 elsif Slice (Sline, 3) = "<" then 504 Res := Cond and (Value1 < Value2); 505 506 elsif Slice (Sline, 3) = "=" then 507 Res := Cond and (Value1 = Value2); 508 509 elsif Slice (Sline, 3) = "/=" then 510 Res := Cond and (Value1 /= Value2); 511 512 else 513 -- No other operator can be used 514 515 Put_Line (Standard_Error, "unknown operator in " & If_Line); 516 Res := False; 517 end if; 518 519 Current_Line := Current_Line + 1; 520 521 loop 522 Get_Line (Tmpl_File, Line, Last); 523 Current_Line := Current_Line + 1; 524 exit when Line (1 .. Last) = "@END_IF"; 525 526 if Last > 4 and then Line (1 .. 4) = "@IF " then 527 Parse_Cond 528 (Line (1 .. Last), Res, 529 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); 530 531 elsif Line (1 .. Last) = "@ELSE" then 532 Res := Cond and not Res; 533 534 elsif Res then 535 Put_Line (Ada_OFile, Line (1 .. Last)); 536 Put_Line (C_OFile, Line (1 .. Last)); 537 end if; 538 end loop; 539 end Parse_Cond; 540 541 --------------- 542 -- Parse_Int -- 543 --------------- 544 545 function Parse_Int 546 (S : String; 547 K : Asm_Int_Kind) return Int_Value_Type 548 is 549 First : Integer := S'First; 550 Result : Int_Value_Type; 551 552 begin 553 -- On some platforms, immediate integer values are prefixed with 554 -- a $ or # character in assembly output. 555 556 if S (First) = '$' or else S (First) = '#' then 557 First := First + 1; 558 end if; 559 560 if S (First) = '-' then 561 Result.Positive := False; 562 First := First + 1; 563 else 564 Result.Positive := True; 565 end if; 566 567 Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last)); 568 569 if not Result.Positive and then K = CNU then 570 571 -- Negative value, but unsigned expected: take 2's complement 572 -- reciprocical value. 573 574 Result.Abs_Value := ((not Result.Abs_Value) + 1) 575 and 576 (Shift_Left (1, Size_Of_Unsigned_Int) - 1); 577 Result.Positive := True; 578 end if; 579 580 return Result; 581 582 exception 583 when others => 584 Put_Line (Standard_Error, "can't parse decimal value: " & S); 585 raise; 586 end Parse_Int; 587 588 ------------ 589 -- Spaces -- 590 ------------ 591 592 function Spaces (Count : Integer) return String is 593 begin 594 if Count <= 0 then 595 return ""; 596 else 597 return (1 .. Count => ' '); 598 end if; 599 end Spaces; 600 601 -- Local declarations 602 603 -- Input files 604 605 Tmpl_File_Name : constant String := Tmpl_Name & ".i"; 606 Asm_File_Name : constant String := Tmpl_Name & ".s"; 607 608 -- Output files 609 610 Ada_File_Name : constant String := Unit_Name & ".ads"; 611 C_File_Name : constant String := Unit_Name & ".h"; 612 613 Asm_File : Ada.Text_IO.File_Type; 614 Tmpl_File : Ada.Text_IO.File_Type; 615 Ada_OFile : Sfile; 616 C_OFile : Sfile; 617 618 Line : String (1 .. 256); 619 Last : Integer; 620 -- Line being processed 621 622 Current_Line : Integer; 623 Current_Info : Integer; 624 In_Comment : Boolean; 625 In_Template : Boolean := False; 626 627-- Start of processing for XOSCons 628 629begin 630 -- Load values from assembly file 631 632 Open (Asm_File, In_File, Asm_File_Name); 633 while not End_Of_File (Asm_File) loop 634 Get_Line (Asm_File, Line, Last); 635 if Last > 2 and then Line (1 .. 2) = "->" then 636 Parse_Asm_Line (Line (3 .. Last)); 637 end if; 638 end loop; 639 640 Close (Asm_File); 641 642 -- Load C template and output definitions 643 644 Open (Tmpl_File, In_File, Tmpl_File_Name); 645 Create (Ada_OFile, Out_File, Ada_File_Name); 646 Create (C_OFile, Out_File, C_File_Name); 647 648 Current_Line := 0; 649 Current_Info := Asm_Infos.First; 650 In_Comment := False; 651 652 while not End_Of_File (Tmpl_File) loop 653 <<Get_One_Line>> 654 Get_Line (Tmpl_File, Line, Last); 655 656 if Last >= 2 and then Line (1 .. 2) = "# " then 657 declare 658 Index : Integer; 659 660 begin 661 Index := 3; 662 while Index <= Last and then Line (Index) in '0' .. '9' loop 663 Index := Index + 1; 664 end loop; 665 666 if Contains_Template_Name (Line (Index + 1 .. Last)) then 667 Current_Line := Integer'Value (Line (3 .. Index - 1)); 668 In_Template := True; 669 goto Get_One_Line; 670 else 671 In_Template := False; 672 end if; 673 end; 674 675 elsif In_Template then 676 if In_Comment then 677 if Line (1 .. Last) = "*/" then 678 Put_Line (C_OFile, Line (1 .. Last)); 679 In_Comment := False; 680 681 elsif Last > 4 and then Line (1 .. 4) = "@IF " then 682 Parse_Cond 683 (Line (1 .. Last), True, 684 Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); 685 686 else 687 Put_Line (Ada_OFile, Line (1 .. Last)); 688 Put_Line (C_OFile, Line (1 .. Last)); 689 end if; 690 691 elsif Line (1 .. Last) = "/*" then 692 Put_Line (C_OFile, Line (1 .. Last)); 693 In_Comment := True; 694 695 elsif Asm_Infos.Table (Current_Info).Line_Number = Current_Line then 696 if Fixed.Index (Line, "/*NOGEN*/") = 0 then 697 Output_Info (Lang_Ada, Ada_OFile, Current_Info); 698 Output_Info (Lang_C, C_OFile, Current_Info); 699 end if; 700 701 Current_Info := Current_Info + 1; 702 end if; 703 704 Current_Line := Current_Line + 1; 705 end if; 706 end loop; 707 708 Close (Tmpl_File); 709 710exception 711 when E : others => 712 Put_Line ("raised " & Ada.Exceptions.Exception_Information (E)); 713 GNAT.OS_Lib.OS_Exit (1); 714end XOSCons; 715