diff options
Diffstat (limited to 'src/vhdl/translate/ortho_front.adb')
-rw-r--r-- | src/vhdl/translate/ortho_front.adb | 263 |
1 files changed, 158 insertions, 105 deletions
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 667bbfe5b..460e588df 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -17,17 +17,16 @@ -- 02111-1307, USA. with Types; use Types; with Name_Table; +with Iirs; use Iirs; +with Libraries; use Libraries; +with Iirs_Utils; use Iirs_Utils; with Std_Package; -with Back_End; with Flags; +with Configuration; with Translation; -with Iirs; use Iirs; -with Libraries; use Libraries; with Sem; with Errorout; use Errorout; with GNAT.OS_Lib; -with Canon; -with Disp_Vhdl; with Bug; with Trans_Be; with Options; @@ -81,8 +80,7 @@ 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) return Natural is begin Elab_Architecture := null; -- Entity (+ architecture) to elaborate @@ -220,59 +218,185 @@ package body Ortho_Front is end Decode_Option; - -- Lighter version of libraries.is_obselete, since DESIGN_UNIT must be in - -- the currently analyzed design file. - function Is_Obsolete (Design_Unit : Iir_Design_Unit) return Boolean + -- Add dependencies of UNIT in DEP_LIST. If a UNIT or a unit it depends + -- on is obsolete, later units are not inserted and this function returns + -- FALSE. UNIT is not added to DEP_LIST. + function Add_Dependence (Unit : Iir_Design_Unit; Dep_List : Iir_List) + return Boolean is List : Iir_List; El : Iir; begin - if Get_Date (Design_Unit) = Date_Obsolete then - return True; + if Get_Date (Unit) = Date_Obsolete then + return False; end if; - List := Get_Dependence_List (Design_Unit); + List := Get_Dependence_List (Unit); if Is_Null_List (List) then - return False; + return True; end if; for I in Natural loop El := Get_Nth_Element (List, I); exit when Is_Null (El); - -- FIXME: there may be entity_aspect_entity... - if Get_Kind (El) = Iir_Kind_Design_Unit - and then Get_Date (El) = Date_Obsolete + + El := Get_Unit_From_Dependence (El); + + if not Get_Configuration_Mark_Flag (El) then + -- EL is not in the list. + if not Add_Dependence (El, Dep_List) then + -- FIXME: Also mark UNIT to avoid walking again. + -- FIXME: this doesn't work as Libraries cannot write the .cf + -- file if a unit is obsolete. + -- Set_Date (Unit, Date_Obsolete); + return False; + end if; + + -- Add to the list (only once). + Set_Configuration_Mark_Flag (El, True); + Append_Element (Dep_List, El); + end if; + end loop; + return True; + end Add_Dependence; + + procedure Do_Compile (Vhdl_File : Name_Id) + is + Res : Iir_Design_File; + New_Design_File : Iir_Design_File; + Design : Iir_Design_Unit; + Next_Design : Iir_Design_Unit; + + -- List of dependencies. + Dep_List : Iir_List; + + -- List of units to be compiled. It is generally the same units as the + -- one in the design_file, but some may be removed because a unit can be + -- obsoleted (directly or indirectly) by a later unit in the same file. + Units_List : Iir_List; + begin + -- Do not elaborate. + Flags.Flag_Elaborate := False; + + -- Read and parse the file. + Res := Libraries.Load_File (Vhdl_File); + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Analyze all design units. + -- FIXME: outdate the design file? + New_Design_File := Null_Iir; + Design := Get_First_Design_Unit (Res); + while Is_Valid (Design) loop + -- Analyze and canon a design unit. + Libraries.Finish_Compilation (Design, True); + + Next_Design := Get_Chain (Design); + if Errorout.Nbr_Errors = 0 then + Set_Chain (Design, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Design); + New_Design_File := Get_Design_File (Design); + end if; + + Design := Next_Design; + end loop; + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Must have at least one design unit + pragma Assert (Is_Valid (New_Design_File)); + + -- Do late analysis checks. + Design := Get_First_Design_Unit (New_Design_File); + while Is_Valid (Design) loop + Sem.Sem_Analysis_Checks_List + (Design, Is_Warning_Enabled (Warnid_Delayed_Checks)); + Design := Get_Chain (Design); + end loop; + + -- Gather dependencies + pragma Assert (Flags.Flag_Elaborate = False); + Configuration.Flag_Load_All_Design_Units := False; + + -- Exclude std.standard + Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); + + Dep_List := Create_Iir_List; + Units_List := Create_Iir_List; + + Design := Get_First_Design_Unit (New_Design_File); + while Is_Valid (Design) loop + if Add_Dependence (Design, Dep_List) then + -- Discard obsolete units. + Append_Element (Units_List, Design); + end if; + Design := Get_Chain (Design); + end loop; + + if Errorout.Nbr_Errors > 0 then + -- Errors can happen (missing package body for instantiation). + raise Compilation_Error; + end if; + + -- Translate declarations of dependencies. + Translation.Translate_Standard (False); + for I in Natural loop + Design := Get_Nth_Element (Dep_List, I); + exit when Design = Null_Iir; + if Get_Design_File (Design) /= New_Design_File then + -- Do not yet translate units to be compiled. They can appear as + -- dependencies. + Translation.Translate (Design, False); + end if; + end loop; + + -- Compile only now. + -- Note: the order of design unit is kept. + for I in Natural loop + Design := Get_Nth_Element (Units_List, I); + exit when Design = Null_Iir; + + if Get_Kind (Get_Library_Unit (Design)) + = Iir_Kind_Configuration_Declaration then - return True; + -- Defer code generation of configuration declaration. + -- (default binding may change between analysis and + -- elaboration). + Translation.Translate (Design, False); + else + Translation.Translate (Design, True); end if; + + if Errorout.Nbr_Errors > 0 then + -- This can happen (foreign attribute). + raise Compilation_Error; + end if; + + Design := Get_Chain (Design); end loop; - return False; - end Is_Obsolete; + + -- Save the working library. + Libraries.Save_Work_Library; + end Do_Compile; Nbr_Parse : Natural := 0; function Parse (Filename : String_Acc) return Boolean is Res : Iir_Design_File; - New_Design_File : Iir_Design_File; Design : Iir_Design_Unit; Next_Design : Iir_Design_Unit; - - -- The vhdl filename to compile. - Vhdl_File : Name_Id; begin if Nbr_Parse = 0 then -- Initialize only once... Libraries.Load_Std_Library; - -- Here, time_base can be set. + -- Here, time_base can be set. Translation.Initialize; - Canon.Canon_Flag_Add_Labels := True; - if Flags.List_All and then Flags.List_Annotate then - Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit); - end if; - - if Action = Action_Anaelab and then Anaelab_Files /= null - then + if Action = Action_Anaelab and then Anaelab_Files /= null then Libraries.Load_Work_Library (True); else Libraries.Load_Work_Library (False); @@ -354,86 +478,15 @@ package body Ortho_Front is Filename.all & """ ignored)"); return False; end if; - Vhdl_File := Name_Table.Get_Identifier (Filename.all); - - Translation.Translate_Standard (False); - - Flags.Flag_Elaborate := False; - Res := Libraries.Load_File (Vhdl_File); - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Analyze all design units. - -- FIXME: outdate the design file? - New_Design_File := Null_Iir; - Design := Get_First_Design_Unit (Res); - while not Is_Null (Design) loop - -- Sem, canon, annotate a design unit. - Back_End.Finish_Compilation (Design, True); - - Next_Design := Get_Chain (Design); - if Errorout.Nbr_Errors = 0 then - Set_Chain (Design, Null_Iir); - Libraries.Add_Design_Unit_Into_Library (Design); - New_Design_File := Get_Design_File (Design); - end if; - - Design := Next_Design; - end loop; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Do late analysis checks. - Design := Get_First_Design_Unit (New_Design_File); - while not Is_Null (Design) loop - Sem.Sem_Analysis_Checks_List - (Design, Is_Warning_Enabled (Warnid_Delayed_Checks)); - Design := Get_Chain (Design); - end loop; - - -- Compile only now. - if not Is_Null (New_Design_File) then - -- Note: the order of design unit is kept. - Design := Get_First_Design_Unit (New_Design_File); - while not Is_Null (Design) loop - if not Is_Obsolete (Design) then - - if Get_Kind (Get_Library_Unit (Design)) - = Iir_Kind_Configuration_Declaration - then - -- Defer code generation of configuration declaration. - -- (default binding may change between analysis and - -- elaboration). - Translation.Translate (Design, False); - else - Translation.Translate (Design, True); - end if; - - if Errorout.Nbr_Errors > 0 then - -- This can happen (foreign attribute). - raise Compilation_Error; - end if; - end if; - - Design := Get_Chain (Design); - end loop; - end if; - - -- Save the working library. - Libraries.Save_Work_Library; + Do_Compile (Name_Table.Get_Identifier (Filename.all)); end case; + if Flag_Expect_Failure then return False; else return True; end if; exception - --when File_Error => - -- Error_Msg_Option ("cannot open file '" & Filename.all & "'"); - -- return False; when Compilation_Error | Parse_Error => if Flag_Expect_Failure then |