1-- GHDL driver - compile commands. 2-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16with Ada.Command_Line; 17 18with Ghdlmain; use Ghdlmain; 19with Ghdllocal; use Ghdllocal; 20with Options; use Options; 21 22with Types; use Types; 23with Flags; 24with Simple_IO; 25with Name_Table; 26with Files_Map; 27 28with Vhdl.Std_Package; 29with Vhdl.Sem; 30with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; 31with Vhdl.Utils; 32with Vhdl.Configuration; 33with Errorout; use Errorout; 34with Libraries; 35 36package body Ghdlcomp is 37 38 Flag_Expect_Failure : Boolean := False; 39 40 -- Commands which use the mcode compiler. 41 type Command_Comp is abstract new Command_Lib with null record; 42 43 procedure Decode_Option (Cmd : in out Command_Comp; 44 Option : String; 45 Arg : String; 46 Res : out Option_State); 47 procedure Disp_Long_Help (Cmd : Command_Comp); 48 49 procedure Decode_Option (Cmd : in out Command_Comp; 50 Option : String; 51 Arg : String; 52 Res : out Option_State) 53 is 54 pragma Assert (Option'First = 1); 55 begin 56 if Option = "--expect-failure" then 57 Flag_Expect_Failure := True; 58 Res := Option_Ok; 59 elsif Option = "--check-ast" then 60 Flags.Check_Ast_Level := Flags.Check_Ast_Level + 1; 61 Res := Option_Ok; 62 elsif Hooks.Decode_Option.all (Option) then 63 Res := Option_Ok; 64 elsif Option'Length > 18 65 and then Option (1 .. 18) = "--time-resolution=" 66 then 67 Res := Option_Ok; 68 if Option (19 .. Option'Last) = "fs" then 69 Time_Resolution := 'f'; 70 elsif Option (19 .. Option'Last) = "ps" then 71 Time_Resolution := 'p'; 72 elsif Option (19 .. Option'Last) = "ns" then 73 Time_Resolution := 'n'; 74 elsif Option (19 .. Option'Last) = "us" then 75 Time_Resolution := 'u'; 76 elsif Option (19 .. Option'Last) = "ms" then 77 Time_Resolution := 'm'; 78 elsif Option (19 .. Option'Last) = "sec" then 79 Time_Resolution := 's'; 80 elsif Option (19 .. Option'Last) = "auto" then 81 Time_Resolution := 'a'; 82 else 83 Error ("unknown unit name for --time-resolution"); 84 Res := Option_Err; 85 end if; 86 else 87 Decode_Option (Command_Lib (Cmd), Option, Arg, Res); 88 end if; 89 end Decode_Option; 90 91 92 procedure Disp_Long_Help (Cmd : Command_Comp) 93 is 94 use Simple_IO; 95 begin 96 Disp_Long_Help (Command_Lib (Cmd)); 97 Hooks.Disp_Long_Help.all; 98 Put_Line (" --expect-failure Expect analysis/elaboration failure"); 99 Put_Line (" --time-resolution=UNIT Set the resolution of type time"); 100 Put_Line (" UNIT can be fs, ps, ns, us, ms, sec or auto"); 101 end Disp_Long_Help; 102 103 -- Command -r 104 type Command_Run is new Command_Comp with null record; 105 function Decode_Command (Cmd : Command_Run; Name : String) 106 return Boolean; 107 function Get_Short_Help (Cmd : Command_Run) return String; 108 109 procedure Perform_Action (Cmd : in out Command_Run; 110 Args : Argument_List); 111 112 function Decode_Command (Cmd : Command_Run; Name : String) 113 return Boolean 114 is 115 pragma Unreferenced (Cmd); 116 begin 117 return Name = "elab-run" 118 or else Name = "--elab-run" 119 or else Name = "-r" 120 or else Name = "run"; 121 end Decode_Command; 122 123 function Get_Short_Help (Cmd : Command_Run) return String 124 is 125 pragma Unreferenced (Cmd); 126 begin 127 return "elab-run [OPTS] UNIT [ARCH] [RUNOPTS]" 128 & ASCII.LF & " Elaborate and run design UNIT" 129 & ASCII.LF & " aliases: --elab-run, -r, run"; 130 end Get_Short_Help; 131 132 133 procedure Perform_Action (Cmd : in out Command_Run; 134 Args : Argument_List) 135 is 136 pragma Unreferenced (Cmd); 137 Opt_Arg : Natural; 138 begin 139 begin 140 Hooks.Compile_Init.all (False); 141 142 Libraries.Load_Work_Library (False); 143 Flags.Flag_Elaborate_With_Outdated := False; 144 Flags.Flag_Only_Elab_Warnings := True; 145 146 Hooks.Compile_Elab.all ("-r", Args, Opt_Arg); 147 exception 148 when Compilation_Error => 149 if Flag_Expect_Failure then 150 return; 151 else 152 raise; 153 end if; 154 end; 155 Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last)); 156 Hooks.Run.all; 157 end Perform_Action; 158 159 160 -- Command -c xx -r/-e 161 type Command_Compile is new Command_Comp with null record; 162 function Decode_Command (Cmd : Command_Compile; Name : String) 163 return Boolean; 164 function Get_Short_Help (Cmd : Command_Compile) return String; 165 procedure Decode_Option (Cmd : in out Command_Compile; 166 Option : String; 167 Arg : String; 168 Res : out Option_State); 169 procedure Perform_Action (Cmd : in out Command_Compile; 170 Args : Argument_List); 171 172 function Decode_Command (Cmd : Command_Compile; Name : String) 173 return Boolean 174 is 175 pragma Unreferenced (Cmd); 176 begin 177 return Name = "compile" 178 or else Name = "-c"; 179 end Decode_Command; 180 181 function Get_Short_Help (Cmd : Command_Compile) return String 182 is 183 pragma Unreferenced (Cmd); 184 begin 185 return "compile [OPTS] FILEs -e|-r UNIT [ARCH] [RUNOPTS]" 186 & ASCII.LF & " Compile, elaborate (and run) design UNIT" 187 & ASCII.LF & " alias: -c"; 188 end Get_Short_Help; 189 190 procedure Decode_Option (Cmd : in out Command_Compile; 191 Option : String; 192 Arg : String; 193 Res : out Option_State) 194 is 195 begin 196 if Option = "-r" or else Option = "-e" then 197 Res := Option_End; 198 else 199 Decode_Option (Command_Comp (Cmd), Option, Arg, Res); 200 end if; 201 end Decode_Option; 202 203 procedure Compile_Analyze_Init (Load_Work : Boolean := True) is 204 begin 205 Hooks.Compile_Init.all (False); 206 207 Flags.Flag_Elaborate_With_Outdated := True; 208 Flags.Flag_Only_Elab_Warnings := False; 209 210 if Load_Work then 211 Libraries.Load_Work_Library (False); 212 -- Also, load all libraries and files, so that every design unit 213 -- is known. 214 Load_All_Libraries_And_Files; 215 else 216 Libraries.Load_Work_Library (True); 217 end if; 218 end Compile_Analyze_Init; 219 220 procedure Compile_Load_File (File : String) 221 is 222 Res : Iir_Design_File; 223 Design : Iir; 224 Next_Design : Iir; 225 begin 226 Res := Load_File_Name (Name_Table.Get_Identifier (File)); 227 if Errorout.Nbr_Errors > 0 then 228 raise Compilation_Error; 229 end if; 230 231 -- Put units into library. 232 Design := Get_First_Design_Unit (Res); 233 while not Is_Null (Design) loop 234 Next_Design := Get_Chain (Design); 235 Set_Chain (Design, Null_Iir); 236 Libraries.Add_Design_Unit_Into_Library (Design); 237 Design := Next_Design; 238 end loop; 239 end Compile_Load_File; 240 241 function Compile_Analyze_File (File : String) return Iir 242 is 243 Id : constant Name_Id := Name_Table.Get_Identifier (File); 244 Design_File : Iir_Design_File; 245 New_Design_File : Iir_Design_File; 246 Unit : Iir; 247 Next_Unit : Iir; 248 begin 249 -- Load file and parse. 250 Design_File := Load_File_Name (Id); 251 if Design_File = Null_Iir or else Errorout.Nbr_Errors > 0 then 252 -- Stop now in case of error (file not found or parse error). 253 return Design_File; 254 end if; 255 256 -- Analyze and add to the work library. 257 Unit := Get_First_Design_Unit (Design_File); 258 while Unit /= Null_Iir loop 259 Finish_Compilation (Unit, True); 260 261 Next_Unit := Get_Chain (Unit); 262 263 if Errorout.Nbr_Errors = 0 then 264 Set_Chain (Unit, Null_Iir); 265 Libraries.Add_Design_Unit_Into_Library (Unit); 266 New_Design_File := Get_Design_File (Unit); 267 end if; 268 269 Unit := Next_Unit; 270 end loop; 271 272 if Errorout.Nbr_Errors > 0 then 273 return Design_File; 274 end if; 275 276 Free_Iir (Design_File); 277 278 -- Do late analysis checks. 279 Unit := Get_First_Design_Unit (New_Design_File); 280 while Unit /= Null_Iir loop 281 Vhdl.Sem.Sem_Analysis_Checks_List 282 (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks)); 283 Unit := Get_Chain (Unit); 284 end loop; 285 286 return New_Design_File; 287 end Compile_Analyze_File; 288 289 procedure Compile_Elaborate (Unit_Name : String_Access) 290 is 291 Run_Arg : Natural; 292 begin 293 Hooks.Compile_Elab.all ("-c", (1 => Unit_Name), Run_Arg); 294 pragma Unreferenced (Run_Arg); 295 end Compile_Elaborate; 296 297 procedure Compile_Run 298 is 299 No_Arg : constant Argument_List := (1 .. 0 => null); 300 begin 301 Hooks.Set_Run_Options (No_Arg); 302 Hooks.Run.all; 303 end Compile_Run; 304 305 procedure Common_Compile_Init (Analyze_Only : Boolean) is 306 begin 307 if Analyze_Only then 308 if not Setup_Libraries (True) then 309 raise Option_Error; 310 end if; 311 else 312 if not Setup_Libraries (False) 313 or else not Libraries.Load_Std_Library 314 then 315 raise Option_Error; 316 end if; 317 -- WORK library is not loaded. FIXME: why ? 318 end if; 319 320 if Time_Resolution /= 'a' then 321 Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution); 322 end if; 323 end Common_Compile_Init; 324 325 procedure Common_Compile_Elab (Cmd_Name : String; 326 Args : Argument_List; 327 Opt_Arg : out Natural; 328 Config : out Iir) 329 is 330 Prim_Id : Name_Id; 331 Sec_Id : Name_Id; 332 begin 333 Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Prim_Id, Sec_Id); 334 335 Flags.Flag_Elaborate := True; 336 337 Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id); 338 if Config = Null_Iir 339 or else Errorout.Nbr_Errors > 0 340 then 341 raise Compilation_Error; 342 end if; 343 344 -- Check (and possibly abandon) if entity can be at the top of the 345 -- hierarchy. 346 declare 347 Conf_Unit : constant Iir := Get_Library_Unit (Config); 348 Arch : constant Iir := Get_Named_Entity 349 (Get_Block_Specification (Get_Block_Configuration (Conf_Unit))); 350 Entity : constant Iir := Vhdl.Utils.Get_Entity (Arch); 351 begin 352 Vhdl.Configuration.Check_Entity_Declaration_Top (Entity, True); 353 if Nbr_Errors > 0 then 354 raise Compilation_Error; 355 end if; 356 end; 357 end Common_Compile_Elab; 358 359 procedure Perform_Action (Cmd : in out Command_Compile; 360 Args : Argument_List) 361 is 362 pragma Unreferenced (Cmd); 363 Elab_Arg : Natural; 364 Run_Arg : Natural; 365 begin 366 begin 367 if Args'Length > 1 and then 368 (Args (Args'First).all = "-r" or else Args (Args'First).all = "-e") 369 then 370 -- If there is no files, then load the work library, all the 371 -- libraries referenced and all the files. 372 Compile_Analyze_Init (True); 373 Elab_Arg := Args'First + 1; 374 else 375 -- If there is at least one file, do not load the work library. 376 Compile_Analyze_Init (False); 377 Elab_Arg := Natural'Last; 378 for I in Args'Range loop 379 declare 380 Arg : constant String := Args (I).all; 381 begin 382 if Arg = "-r" or else Arg = "-e" then 383 Elab_Arg := I + 1; 384 exit; 385 elsif Arg'Last > 7 and then Arg (1 .. 7) = "--work=" then 386 Libraries.Work_Library_Name := 387 Libraries.Decode_Work_Option (Arg); 388 if Libraries.Work_Library_Name = Null_Identifier then 389 raise Compilation_Error; 390 end if; 391 Libraries.Load_Work_Library (True); 392 else 393 Compile_Load_File (Arg); 394 end if; 395 end; 396 end loop; 397 398 -- Save the library (and do not elaborate) if there is neither 399 -- '-e' nor '-r'. 400 if Elab_Arg = Natural'Last then 401 Libraries.Save_Work_Library; 402 return; 403 end if; 404 end if; 405 406 Hooks.Compile_Elab.all ("-c", Args (Elab_Arg .. Args'Last), Run_Arg); 407 exception 408 when Compilation_Error => 409 if Flag_Expect_Failure then 410 return; 411 else 412 raise; 413 end if; 414 end; 415 if Args (Elab_Arg - 1).all = "-r" then 416 Hooks.Set_Run_Options (Args (Run_Arg .. Args'Last)); 417 Hooks.Run.all; 418 else 419 if Run_Arg <= Args'Last then 420 Error_Msg_Option ("options after unit are ignored"); 421 raise Option_Error; 422 end if; 423 end if; 424 end Perform_Action; 425 426 -- Command -a 427 type Command_Analyze is new Command_Comp with null record; 428 function Decode_Command (Cmd : Command_Analyze; Name : String) 429 return Boolean; 430 function Get_Short_Help (Cmd : Command_Analyze) return String; 431 432 procedure Perform_Action (Cmd : in out Command_Analyze; 433 Args : Argument_List); 434 435 function Decode_Command (Cmd : Command_Analyze; Name : String) 436 return Boolean 437 is 438 pragma Unreferenced (Cmd); 439 begin 440 return Name = "analyze" 441 or else Name = "-a" 442 or else Name = "analyse"; 443 end Decode_Command; 444 445 function Get_Short_Help (Cmd : Command_Analyze) return String 446 is 447 pragma Unreferenced (Cmd); 448 begin 449 return "analyze [OPTS] FILEs" 450 & ASCII.LF & " Analyze one or multiple VHDL files" 451 & ASCII.LF & " aliases: -a, analyse"; 452 end Get_Short_Help; 453 454 procedure Perform_Action (Cmd : in out Command_Analyze; 455 Args : Argument_List) 456 is 457 pragma Unreferenced (Cmd); 458 Id : Name_Id; 459 Design_File : Iir_Design_File; 460 New_Design_File : Iir_Design_File; 461 Unit : Iir; 462 Next_Unit : Iir; 463 begin 464 if Args'Length = 0 then 465 Error ("no file to analyze"); 466 raise Compilation_Error; 467 end if; 468 469 Expect_Filenames (Args); 470 471 Hooks.Compile_Init.all (True); 472 473 -- Parse all files. 474 for I in Args'Range loop 475 Id := Name_Table.Get_Identifier (Args (I).all); 476 477 -- Parse file. 478 Design_File := Load_File_Name (Id); 479 if Errorout.Nbr_Errors > 0 480 and then not Flags.Flag_Force_Analysis 481 then 482 raise Compilation_Error; 483 end if; 484 485 New_Design_File := Null_Iir; 486 487 if False then 488 -- Speed up analysis: remove all previous designs. 489 -- However, this is not in the LRM... 490 Libraries.Purge_Design_File (Design_File); 491 end if; 492 493 if Design_File /= Null_Iir then 494 Unit := Get_First_Design_Unit (Design_File); 495 while Unit /= Null_Iir loop 496 -- Analyze unit. 497 Finish_Compilation (Unit, True); 498 499 Next_Unit := Get_Chain (Unit); 500 501 if Errorout.Nbr_Errors = 0 502 or else (Flags.Flag_Force_Analysis 503 and then Get_Library_Unit (Unit) /= Null_Iir) 504 then 505 Set_Chain (Unit, Null_Iir); 506 Libraries.Add_Design_Unit_Into_Library (Unit); 507 New_Design_File := Get_Design_File (Unit); 508 end if; 509 510 Unit := Next_Unit; 511 end loop; 512 513 if Errorout.Nbr_Errors > 0 514 and then not Flags.Flag_Force_Analysis 515 then 516 raise Compilation_Error; 517 end if; 518 519 if New_Design_File = Design_File then 520 pragma Assert (Flags.Flag_Force_Analysis); 521 null; 522 else 523 Free_Iir (Design_File); 524 end if; 525 526 -- Do late analysis checks. 527 if New_Design_File /= Null_Iir then 528 Unit := Get_First_Design_Unit (New_Design_File); 529 while Unit /= Null_Iir loop 530 Vhdl.Sem.Sem_Analysis_Checks_List 531 (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks)); 532 Unit := Get_Chain (Unit); 533 end loop; 534 535 if Errorout.Nbr_Errors > 0 536 and then not Flags.Flag_Force_Analysis 537 then 538 raise Compilation_Error; 539 end if; 540 end if; 541 end if; 542 end loop; 543 544 if Errorout.Nbr_Errors > 0 then 545 raise Compilation_Error; 546 end if; 547 548 if Flag_Expect_Failure then 549 raise Compilation_Error; 550 end if; 551 552 Libraries.Save_Work_Library; 553 554 exception 555 when Compilation_Error => 556 if Flag_Expect_Failure and Errorout.Nbr_Errors /= 0 then 557 return; 558 else 559 raise; 560 end if; 561 end Perform_Action; 562 563 -- Command -e 564 type Command_Elab is new Command_Comp with null record; 565 function Decode_Command (Cmd : Command_Elab; Name : String) 566 return Boolean; 567 function Get_Short_Help (Cmd : Command_Elab) return String; 568 procedure Decode_Option (Cmd : in out Command_Elab; 569 Option : String; 570 Arg : String; 571 Res : out Option_State); 572 573 procedure Perform_Action (Cmd : in out Command_Elab; 574 Args : Argument_List); 575 576 function Decode_Command (Cmd : Command_Elab; Name : String) 577 return Boolean 578 is 579 pragma Unreferenced (Cmd); 580 begin 581 return Name = "elaborate" 582 or else Name = "-e"; 583 end Decode_Command; 584 585 function Get_Short_Help (Cmd : Command_Elab) return String 586 is 587 pragma Unreferenced (Cmd); 588 begin 589 return "elaborate [OPTS] UNIT [ARCH]" 590 & ASCII.LF & " Elaborate design UNIT" 591 & ASCII.LF & " alias: -e"; 592 end Get_Short_Help; 593 594 procedure Decode_Option (Cmd : in out Command_Elab; 595 Option : String; 596 Arg : String; 597 Res : out Option_State) 598 is 599 pragma Assert (Option'First = 1); 600 begin 601 if Option = "-o" then 602 if Arg'Length = 0 then 603 Res := Option_Arg_Req; 604 else 605 -- Silently accepted. 606 Res := Option_Arg; 607 end if; 608 elsif Option'Length >= 4 and then Option (1 .. 4) = "-Wl," then 609 Error_Msg_Option ("option -Wl is not available when ghdl " 610 & "is not configured with gcc or llvm"); 611 Res := Option_Err; 612 else 613 Decode_Option (Command_Comp (Cmd), Option, Arg, Res); 614 end if; 615 end Decode_Option; 616 617 procedure Perform_Action (Cmd : in out Command_Elab; 618 Args : Argument_List) 619 is 620 pragma Unreferenced (Cmd); 621 Run_Arg : Natural; 622 begin 623 Hooks.Compile_Init.all (False); 624 625 Libraries.Load_Work_Library (False); 626 Flags.Flag_Elaborate_With_Outdated := False; 627 Flags.Flag_Only_Elab_Warnings := True; 628 629 Hooks.Compile_Elab.all ("-e", Args, Run_Arg); 630 if Run_Arg <= Args'Last then 631 Error_Msg_Option ("options after unit are ignored"); 632 raise Option_Error; 633 end if; 634 if Flag_Expect_Failure then 635 raise Compilation_Error; 636 end if; 637 exception 638 when Compilation_Error => 639 if Flag_Expect_Failure and then Errorout.Nbr_Errors > 0 then 640 return; 641 else 642 raise; 643 end if; 644 end Perform_Action; 645 646 -- Command dispconfig. 647 type Command_Dispconfig is new Command_Lib with null record; 648 function Decode_Command (Cmd : Command_Dispconfig; Name : String) 649 return Boolean; 650 function Get_Short_Help (Cmd : Command_Dispconfig) return String; 651 procedure Perform_Action (Cmd : in out Command_Dispconfig; 652 Args : Argument_List); 653 654 function Decode_Command (Cmd : Command_Dispconfig; Name : String) 655 return Boolean 656 is 657 pragma Unreferenced (Cmd); 658 begin 659 return Name = "disp-config" 660 or else Name = "--disp-config" 661 or else Name = "dispconfig" 662 or else Name = "--dispconfig"; 663 end Decode_Command; 664 665 function Get_Short_Help (Cmd : Command_Dispconfig) return String 666 is 667 pragma Unreferenced (Cmd); 668 begin 669 return "disp-config" 670 & ASCII.LF & " Display tools path" 671 & ASCII.LF & " aliases: --disp-config, dispconfig, --dispconfig"; 672 end Get_Short_Help; 673 674 procedure Disp_Config 675 is 676 use Simple_IO; 677 use Libraries; 678 begin 679 Disp_Config_Prefixes; 680 681 Put_Line ("default library paths:"); 682 for I in 2 .. Get_Nbr_Paths loop 683 Put (' '); 684 Put_Line (Name_Table.Image (Get_Path (I))); 685 end loop; 686 end Disp_Config; 687 688 procedure Perform_Action (Cmd : in out Command_Dispconfig; 689 Args : Argument_List) 690 is 691 pragma Unreferenced (Cmd); 692 use Simple_IO; 693 begin 694 if Args'Length /= 0 then 695 Error ("--disp-config does not accept any argument"); 696 raise Option_Error; 697 end if; 698 Put_Line ("command_name: " & Ada.Command_Line.Command_Name); 699 700 Disp_Config; 701 end Perform_Action; 702 703 -- Command Make. 704 type Command_Make is new Command_Comp with null record; 705 function Decode_Command (Cmd : Command_Make; Name : String) 706 return Boolean; 707 function Get_Short_Help (Cmd : Command_Make) return String; 708 procedure Perform_Action (Cmd : in out Command_Make; 709 Args : Argument_List); 710 711 function Decode_Command (Cmd : Command_Make; Name : String) 712 return Boolean 713 is 714 pragma Unreferenced (Cmd); 715 begin 716 return Name = "make" 717 or else Name = "-m"; 718 end Decode_Command; 719 720 function Get_Short_Help (Cmd : Command_Make) return String 721 is 722 pragma Unreferenced (Cmd); 723 begin 724 return "make [OPTS] UNIT [ARCH]" 725 & ASCII.LF & " Make design UNIT" 726 & ASCII.LF & " alias: -m"; 727 end Get_Short_Help; 728 729 procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List) 730 is 731 pragma Unreferenced (Cmd); 732 733 Prim_Id : Name_Id; 734 Sec_Id : Name_Id; 735 Files_List : Iir_List; 736 File : Iir_Design_File; 737 It : List_Iterator; 738 739 Next_Arg : Natural; 740 Date : Date_Type; 741 Unit : Iir_Design_Unit; 742 Lib : Iir_Library_Declaration; 743 begin 744 Extract_Elab_Unit ("-m", Args, Next_Arg, Prim_Id, Sec_Id); 745 if not Setup_Libraries (True) then 746 return; 747 end if; 748 749 -- Create list of files. 750 Files_List := Build_Dependence (Prim_Id, Sec_Id); 751 752 -- Unmark all libraries. 753 Lib := Libraries.Std_Library; 754 while Lib /= Null_Iir loop 755 Set_Elab_Flag (Lib, False); 756 Lib := Get_Chain (Lib); 757 end loop; 758 759 Date := Get_Date (Libraries.Work_Library); 760 It := List_Iterate (Files_List); 761 while Is_Valid (It) loop 762 File := Get_Element (It); 763 764 if File = Vhdl.Std_Package.Std_Standard_File then 765 null; 766 elsif Source_File_Modified (File) 767 or else Is_File_Outdated (File) 768 then 769 Lib := Get_Library (File); 770 Date := Get_Date (Lib); 771 772 -- Mark this file as analyzed. 773 Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp); 774 775 Unit := Get_First_Design_Unit (File); 776 while Unit /= Null_Iir loop 777 if Get_Date (Unit) = Date_Analyzed 778 or else Get_Date (Unit) in Date_Valid 779 then 780 Date := Date + 1; 781 Set_Date (Unit, Date); 782 end if; 783 Unit := Get_Chain (Unit); 784 end loop; 785 786 Set_Date (Lib, Date); 787 788 -- Need to be written to disk. 789 Set_Elab_Flag (Lib, True); 790 end if; 791 792 Next (It); 793 end loop; 794 795 -- Save modified libraries. 796 if Get_Elab_Flag (Libraries.Work_Library) then 797 Libraries.Save_Work_Library; 798 Set_Elab_Flag (Libraries.Work_Library, False); 799 end if; 800 801 declare 802 use Libraries; 803 Old_Work_Library : constant Iir_Library_Declaration := Work_Library; 804 Old_Work_Library_Name : constant Name_Id := Work_Library_Name; 805 Old_Work_Directory : constant Name_Id := Work_Directory; 806 begin 807 Lib := Libraries.Std_Library; 808 while Lib /= Null_Iir loop 809 if Get_Elab_Flag (Lib) then 810 if Lib = Std_Library then 811 Error ("need to rebuild std library"); 812 raise Compile_Error; 813 end if; 814 Work_Library := Lib; 815 Work_Library_Name := Get_Identifier (Lib); 816 Work_Directory := Get_Library_Directory (Lib); 817 Libraries.Save_Work_Library; 818 Set_Elab_Flag (Lib, False); 819 end if; 820 Lib := Get_Chain (Lib); 821 end loop; 822 Work_Library := Old_Work_Library; 823 Work_Library_Name := Old_Work_Library_Name; 824 Work_Directory := Old_Work_Directory; 825 end; 826 exception 827 when Compilation_Error => 828 if Flag_Expect_Failure then 829 return; 830 else 831 raise; 832 end if; 833 end Perform_Action; 834 835 -- Command Gen_Makefile. 836 type Command_Gen_Makefile is new Command_Lib with null record; 837 function Decode_Command (Cmd : Command_Gen_Makefile; Name : String) 838 return Boolean; 839 function Get_Short_Help (Cmd : Command_Gen_Makefile) return String; 840 procedure Perform_Action (Cmd : in out Command_Gen_Makefile; 841 Args : Argument_List); 842 843 function Decode_Command (Cmd : Command_Gen_Makefile; Name : String) 844 return Boolean 845 is 846 pragma Unreferenced (Cmd); 847 begin 848 return Name = "gen-makefile" 849 or else Name = "--gen-makefile"; 850 end Decode_Command; 851 852 function Get_Short_Help (Cmd : Command_Gen_Makefile) return String 853 is 854 pragma Unreferenced (Cmd); 855 begin 856 return "gen-makefile [OPTS] UNIT [ARCH]" 857 & ASCII.LF & " Generate a Makefile for UNIT" 858 & ASCII.LF & " alias: --gen-makefile"; 859 end Get_Short_Help; 860 861 function Is_Makeable_File (File : Iir_Design_File) return Boolean is 862 begin 863 if File = Vhdl.Std_Package.Std_Standard_File then 864 return False; 865 end if; 866 return True; 867 end Is_Makeable_File; 868 869 procedure Perform_Action (Cmd : in out Command_Gen_Makefile; 870 Args : Argument_List) 871 is 872 pragma Unreferenced (Cmd); 873 use Simple_IO; 874 use Name_Table; 875 876 HT : constant Character := ASCII.HT; 877 Prim_Id : Name_Id; 878 Sec_Id : Name_Id; 879 Files_List : Iir_List; 880 File : Iir_Design_File; 881 Files_It : List_Iterator; 882 883 Lib : Iir_Library_Declaration; 884 Dir_Id : Name_Id; 885 886 Next_Arg : Natural; 887 begin 888 Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg, Prim_Id, Sec_Id); 889 if not Setup_Libraries (True) then 890 return; 891 end if; 892 Files_List := Build_Dependence (Prim_Id, Sec_Id); 893 894 Ghdllocal.Gen_Makefile_Disp_Header; 895 896 New_Line; 897 898 Ghdllocal.Gen_Makefile_Disp_Variables; 899 900 Put ("GHDLRUNFLAGS="); 901 for I in Next_Arg .. Args'Last loop 902 Put (' '); 903 Put (Args (I).all); 904 end loop; 905 New_Line; 906 New_Line; 907 908 Put_Line ("# Default target : elaborate"); 909 Put_Line ("all : elab"); 910 New_Line; 911 912 Put_Line ("# Elaborate target. Almost useless"); 913 Put_Line ("elab : force"); 914 Put (HT & "$(GHDL) -c $(GHDLFLAGS) -e "); 915 Put (Image (Prim_Id)); 916 if Sec_Id /= Null_Identifier then 917 Put (' '); 918 Put (Image (Sec_Id)); 919 end if; 920 New_Line; 921 New_Line; 922 923 Put_Line ("# Run target"); 924 Put_Line ("run : force"); 925 Put (HT & "$(GHDL) -c $(GHDLFLAGS) -r "); 926 Put (Image (Prim_Id)); 927 if Sec_Id /= Null_Identifier then 928 Put (' '); 929 Put (Image (Sec_Id)); 930 end if; 931 Put (" $(GHDLRUNFLAGS)"); 932 New_Line; 933 New_Line; 934 935 Put_Line ("# Targets to analyze libraries"); 936 Put_Line ("init: force"); 937 Files_It := List_Iterate (Files_List); 938 while Is_Valid (Files_It) loop 939 File := Get_Element (Files_It); 940 Dir_Id := Get_Design_File_Directory (File); 941 if not Is_Makeable_File (File) then 942 -- Builtin file. 943 null; 944 elsif Dir_Id /= Files_Map.Get_Home_Directory then 945 -- Not locally built file. 946 Put (HT & "# "); 947 Put (Image (Dir_Id)); 948 Put (Image (Get_Design_File_Filename (File))); 949 New_Line; 950 else 951 952 Put (HT & "$(GHDL) -a $(GHDLFLAGS)"); 953 Lib := Get_Library (File); 954 if Lib /= Libraries.Work_Library then 955 -- Overwrite some options. 956 Put (" --work="); 957 Put (Image (Get_Identifier (Lib))); 958 Dir_Id := Get_Library_Directory (Lib); 959 Put (" --workdir="); 960 if Dir_Id = Libraries.Local_Directory then 961 Put ("."); 962 else 963 Put (Image (Dir_Id)); 964 end if; 965 end if; 966 Put (' '); 967 Put (Image (Get_Design_File_Filename (File))); 968 New_Line; 969 end if; 970 Next (Files_It); 971 end loop; 972 New_Line; 973 974 Put_Line ("force:"); 975 end Perform_Action; 976 977 procedure Register_Commands is 978 begin 979 Register_Command (new Command_Analyze); 980 Register_Command (new Command_Elab); 981 Register_Command (new Command_Run); 982 Register_Command (new Command_Compile); 983 Register_Command (new Command_Make); 984 Register_Command (new Command_Gen_Makefile); 985 Register_Command (new Command_Dispconfig); 986 end Register_Commands; 987 988end Ghdlcomp; 989