diff options
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 26 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlrun.adb | 29 | ||||
| -rw-r--r-- | src/vhdl/translate/ortho_front.adb | 35 |
3 files changed, 79 insertions, 11 deletions
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 31ca44b4a..03861f793 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -81,6 +81,17 @@ package body Ghdldrv is -- True if failure expected. Flag_Expect_Failure : Boolean; + -- Elaboration mode. + type Elab_Mode_Type is + (-- Static elaboration (or pre-elaboration). + Elab_Static, + + -- Dynamic elaboration: design is elaborated just before being run. + Elab_Dynamic); + + -- Default elaboration mode is dynamic. + Elab_Mode : Elab_Mode_Type := Elab_Dynamic; + -- Argument table for the tools. -- Each table low bound is 1 so that the length of a table is equal to -- the last bound. @@ -651,6 +662,12 @@ package body Ghdldrv is -- for -C. Done before Flags.Parse_Option. Add_Argument (Compiler_Args, new String'("--mb-comments")); Res := Option_Ok; + elsif Opt = "--pre-elab" then + Elab_Mode := Elab_Static; + Res := Option_Ok; + elsif Opt = "--dyn-elab" then + Elab_Mode := Elab_Dynamic; + Res := Option_Ok; elsif Options.Parse_Option (Opt) then if Opt'Length > 2 and then Opt (1 .. 2) = "-P" then -- Discard -Pxxx switches, as they are already added to @@ -911,10 +928,17 @@ package body Ghdldrv is procedure Bind is Comp_List : Argument_List (1 .. 4); + Elab_Cmd : String_Access; begin Filelist_Name := new String'(Elab_Name.all & List_Suffix); - Comp_List (1) := new String'("--elab"); + case Elab_Mode is + when Elab_Static => + Elab_Cmd := new String'("--pre-elab"); + when Elab_Dynamic => + Elab_Cmd := new String'("--elab"); + end case; + Comp_List (1) := Elab_Cmd; Comp_List (2) := Unit_Name; Comp_List (3) := new String'("-l"); Comp_List (4) := Filelist_Name; diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 3f0cd10c6..698879202 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -66,6 +66,17 @@ with Foreigns; with Grtlink; package body Ghdlrun is + -- Elaboration mode. + type Elab_Mode_Type is + (-- Static elaboration (or pre-elaboration). + Elab_Static, + + -- Dynamic elaboration: design is elaborated just before being run. + Elab_Dynamic); + + -- Default elaboration mode is dynamic. + Elab_Mode : constant Elab_Mode_Type := Elab_Dynamic; + procedure Foreign_Hook (Decl : Iir; Info : Translation.Foreign_Info_Type; Ortho : O_Dnode); @@ -90,7 +101,16 @@ package body Ghdlrun is Ortho_Jit.Init; Translation.Initialize; - Canon.Canon_Flag_Add_Labels := True; + + case Elab_Mode is + when Elab_Static => + Canon.Canon_Flag_Add_Labels := True; + Canon.Canon_Flag_Sequentials_Stmts := True; + Canon.Canon_Flag_Expressions := True; + Canon.Canon_Flag_All_Sensitivity := True; + when Elab_Dynamic => + Canon.Canon_Flag_Add_Labels := True; + end case; end Compile_Init; procedure Compile_Elab @@ -103,7 +123,12 @@ package body Ghdlrun is end if; Flags.Flag_Elaborate := True; - Translation.Elaborate (Prim_Name.all, Sec_Name.all, "", True); + case Elab_Mode is + when Elab_Static => + raise Program_Error; + when Elab_Dynamic => + Translation.Elaborate (Prim_Name.all, Sec_Name.all, "", True); + end case; if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 8867ba63e..ac83f6142 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -38,9 +38,12 @@ package body Ortho_Front is -- Normal mode: compile a design file. Action_Compile, - -- Elaborate a design unit. + -- Generate code to elaborate a design unit. Action_Elaborate, + -- Elaborate a design. + Action_Pre_Elaborate, + -- Analyze files and elaborate unit. Action_Anaelab, @@ -80,13 +83,14 @@ package body Ortho_Front is Flag_Expect_Failure := False; end Init; - function Decode_Elab_Option (Arg : String_Acc) return Natural is + function Decode_Elab_Option (Arg : String_Acc; Cmd : String) + return Natural is begin Elab_Architecture := null; -- Entity (+ architecture) to elaborate if Arg = null then Error_Msg_Option - ("entity or configuration name required after --elab"); + ("entity or configuration name required after " & Cmd); return 0; end if; if Arg (Arg.all'Last) = ')' then @@ -101,7 +105,7 @@ package body Ortho_Front is Len := P - Arg.all'First + 1; -- Must be at least 'e(a)'. if Len < 4 then - Error_Msg_Option ("ill-formed name after --elab"); + Error_Msg_Option ("ill-formed name after " & Cmd); return 0; end if; -- Handle extended name. @@ -113,7 +117,7 @@ package body Ortho_Front is end if; loop if P = Arg.all'First then - Error_Msg_Option ("ill-formed name after --elab"); + Error_Msg_Option ("ill-formed name after " & Cmd); return 0; end if; exit when Arg (P) = '(' and Is_Ext = False; @@ -124,7 +128,7 @@ package body Ortho_Front is P := P - 1; exit; else - Error_Msg_Option ("ill-formed name after --elab"); + Error_Msg_Option ("ill-formed name after " & Cmd); return 0; end if; else @@ -154,14 +158,21 @@ package body Ortho_Front is return 0; end if; Action := Action_Elaborate; - return Decode_Elab_Option (Arg); + return Decode_Elab_Option (Arg, "--elab"); + elsif Opt.all = "--pre-elab" then + if Action /= Action_Compile then + Error_Msg_Option ("several --pre-elab options"); + return 0; + end if; + Action := Action_Pre_Elaborate; + return Decode_Elab_Option (Arg, "--pre-elab"); elsif Opt.all = "--anaelab" then if Action /= Action_Compile then Error_Msg_Option ("several --anaelab options"); return 0; end if; Action := Action_Anaelab; - return Decode_Elab_Option (Arg); + return Decode_Elab_Option (Arg, "--anaelab"); elsif Opt'Length > 14 and then Opt (Opt'First .. Opt'First + 13) = "--ghdl-source=" then @@ -414,6 +425,14 @@ package body Ortho_Front is -- This may happen (bad entity for example). raise Compilation_Error; end if; + when Action_Pre_Elaborate => + Flags.Flag_Elaborate := True; + Flags.Flag_Only_Elab_Warnings := True; + if Elab_Filelist = null then + Error_Msg_Option ("missing -l for --pre-elab"); + raise Option_Error; + end if; + raise Program_Error; when Action_Anaelab => -- Parse files. if Anaelab_Files = null then |