path: root/src/vhdl/vhdl-sem_stmts.adb

--  Semantic analysis.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
--  GHDL is free software; you can redistribute it and/or modify it under
--  the terms of the GNU General Public License as published by the Free
--  Software Foundation; either version 2, or (at your option) any later
--  version.
--
--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
--  for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with GHDL; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with Errorout; use Errorout;
with Types; use Types;
with Flags; use Flags;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Specs; use Vhdl.Sem_Specs;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Sem; use Vhdl.Sem;
with Vhdl.Sem_Decls; use Vhdl.Sem_Decls;
with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;
with Vhdl.Sem_Names; use Vhdl.Sem_Names;
with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
with Vhdl.Sem_Types;
with Vhdl.Sem_Psl;
with Std_Names;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Xrefs; use Vhdl.Xrefs;

package body Vhdl.Sem_Stmts is
   -- Process is the scope, this is also the process for which drivers can
   -- be created.
   -- Note: FIRST_STMT is the first statement, which can be get by:
   --  get_sequential_statement_chain (usual)
   --  get_associated_chain (for case statement).
   procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir);

   procedure Sem_Simultaneous_Statements (First : Iir);

   -- Access to the current subprogram or process.
   Current_Subprogram: Iir := Null_Iir;

   function Get_Current_Subprogram return Iir is
   begin
      return Current_Subprogram;
   end Get_Current_Subprogram;

   -- Access to the current concurrent statement.
   -- Null_iir if no one.
   Current_Concurrent_Statement : Iir := Null_Iir;

   function Get_Current_Concurrent_Statement return Iir is
   begin
      return Current_Concurrent_Statement;
   end Get_Current_Concurrent_Statement;

   --  LRM 8 Sequential statements.
   --  All statements may be labeled.
   --  Such labels are implicitly declared at the beginning of the declarative
   --  part of the innermost enclosing process statement of subprogram body.
   procedure Sem_Sequential_Labels (First_Stmt : Iir)
   is
      Stmt: Iir;
      Label: Name_Id;
   begin
      Stmt := First_Stmt;
      while Stmt /= Null_Iir loop
         Label := Get_Label (Stmt);
         if Label /= Null_Identifier then
            Sem_Scopes.Add_Name (Stmt);
            Name_Visible (Stmt);
            Xref_Decl (Stmt);
         end if;

         --  Some statements have sub-lists of statements.
         case Get_Kind (Stmt) is
            when Iir_Kind_For_Loop_Statement
              | Iir_Kind_While_Loop_Statement =>
               Sem_Sequential_Labels (Get_Sequential_Statement_Chain (Stmt));
            when Iir_Kind_If_Statement =>
               declare
                  Clause : Iir;
               begin
                  Clause := Stmt;
                  while Clause /= Null_Iir loop
                     Sem_Sequential_Labels
                       (Get_Sequential_Statement_Chain (Clause));
                     Clause := Get_Else_Clause (Clause);
                  end loop;
               end;
            when Iir_Kind_Case_Statement =>
               declare
                  El : Iir;
               begin
                  El := Get_Case_Statement_Alternative_Chain (Stmt);
                  while El /= Null_Iir loop
                     Sem_Sequential_Labels (Get_Associated_Chain (El));
                     El := Get_Chain (El);
                  end loop;
               end;
            when others =>
               null;
         end case;
         Stmt := Get_Chain (Stmt);
      end loop;
   end Sem_Sequential_Labels;

   procedure Fill_Array_From_Aggregate_Associated
     (Chain : Iir; Nbr : in out Natural; Arr : in out Iir_Array)
   is
      El : Iir;
      Ass : Iir;
   begin
      El := Chain;
      while El /= Null_Iir loop
         Ass := Get_Associated_Expr (El);
         if Get_Kind (Ass) = Iir_Kind_Aggregate then
            Fill_Array_From_Aggregate_Associated
              (Get_Association_Choices_Chain (Ass), Nbr, Arr);
         else
            Arr (Nbr) := Ass;
            Nbr := Nbr + 1;
         end if;
         El := Get_Chain (El);
      end loop;
   end Fill_Array_From_Aggregate_Associated;

   --  Return TRUE iff there is no common elements designed by N1 and N2.
   --  N1 and N2 are static names.
   --  FIXME:  The current implementation is completly wrong; should check from
   --   prefix to suffix.
   function Is_Disjoint (N1, N2: Iir) return Boolean
   is
      List1, List2 : Iir_Flist;
      El1, El2 : Iir;
   begin
      if N1 = N2 then
         return False;
      end if;
      if Get_Kind (N1) = Iir_Kind_Indexed_Name
        and then Get_Kind (N2) = Iir_Kind_Indexed_Name
      then
         if Is_Disjoint (Get_Prefix (N1), Get_Prefix (N2)) then
            return True;
         end if;
         --  Check indexes.
         List1 := Get_Index_List (N1);
         List2 := Get_Index_List (N2);
         for I in Flist_First .. Flist_Last (List1) loop
            El1 := Get_Nth_Element (List1, I);
            El2 := Get_Nth_Element (List2, I);
            El1 := Eval_Expr (El1);
            Set_Nth_Element (List1, I, El1);
            El2 := Eval_Expr (El2);
            Set_Nth_Element (List2, I, El2);
            --  EL are of discrete type.
            if Get_Value (El1) /= Get_Value (El2) then
               return True;
            end if;
         end loop;
         return False;
      elsif Get_Kind (N1) in Iir_Kinds_Denoting_Name
        and then Get_Kind (N2) in Iir_Kinds_Denoting_Name
      then
         return Get_Named_Entity (N1) /= Get_Named_Entity (N2);
      else
         return True;
      end if;
   end Is_Disjoint;

   procedure Check_Uniq_Aggregate_Associated
     (Aggr : Iir_Aggregate; Nbr : Natural)
   is
      Chain : constant Iir := Get_Association_Choices_Chain (Aggr);
      subtype El_Array_Type is Iir_Array (0 .. Nbr - 1);
      Name_Arr, Obj_Arr : El_Array_Type;
      Index : Natural;
      El : Iir;
   begin
      --  Fill the array.
      Index := 0;
      Fill_Array_From_Aggregate_Associated (Chain, Index, Name_Arr);
      --  Should be the same.
      pragma Assert (Index = Nbr);

      --  Replace name with object.  Return now in case of error (not an
      --  object or not a static name).
      for I in Name_Arr'Range loop
         El := Name_To_Object (Name_Arr (I));
         if El = Null_Iir
           or else Get_Name_Staticness (El) /= Locally
         then
            --  Error...
            return;
         end if;
         Obj_Arr (I) := El;
      end loop;

      --  Check each element is uniq.
      for I in Name_Arr'Range loop
         for J in 0 .. I - 1 loop
            if not Is_Disjoint (Obj_Arr (I), Obj_Arr (J)) then
               Report_Start_Group;
               Error_Msg_Sem
                 (+Name_Arr (I), "target is assigned more than once");
               Error_Msg_Sem
                 (+Name_Arr (J), " (previous assignment is here)");
               Report_End_Group;
               return;
            end if;
         end loop;
      end loop;
   end Check_Uniq_Aggregate_Associated;

   --  Do checks for the target of an assignment.
   procedure Check_Simple_Signal_Target
     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness);
   --  STMT is used to localize the error (if any).
   procedure Check_Simple_Variable_Target
     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness);

   -- Semantic associed with signal mode.
   -- See LRM93 4.3.3 (or LRM08 6.5.2)
   type Boolean_Array_Of_Iir_Mode is array (Iir_Mode) of Boolean;
   Iir_Mode_Readable : constant Boolean_Array_Of_Iir_Mode :=
     (Iir_Unknown_Mode => False,
      Iir_In_Mode => True,
      Iir_Out_Mode => False,
      Iir_Inout_Mode => True,
      Iir_Buffer_Mode => True,
      Iir_Linkage_Mode => False);
   Iir_Mode_Writable : constant Boolean_Array_Of_Iir_Mode :=
     (Iir_Unknown_Mode => False,
      Iir_In_Mode => False,
      Iir_Out_Mode => True,
      Iir_Inout_Mode => True,
      Iir_Buffer_Mode => True,
      Iir_Linkage_Mode => False);

   --  Return True iff signal interface INTER is readable.
   function Is_Interface_Signal_Readable (Inter : Iir) return Boolean
   is
      pragma Assert (Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration);
      Mode : constant Iir_Mode := Get_Mode (Inter);
   begin
      if Mode = Iir_Out_Mode and then Flags.Vhdl_Std >= Vhdl_08 then
         --  LRM08 6.5.2 Interface object declarations
         --  OUT.  The value of the inerface object is allowed [...] and
         --  provided it is not a signal parameter, read.
         return not Is_Parameter (Inter);
      else
         return Iir_Mode_Readable (Mode);
      end if;
   end Is_Interface_Signal_Readable;

   procedure Check_Aggregate_Target
     (Stmt : Iir; Target : Iir; Nbr : in out Natural)
   is
      Choice : Iir;
      Ass : Iir;
   begin
      Choice := Get_Association_Choices_Chain (Target);
      while Choice /= Null_Iir loop
         case Get_Kind (Choice) is
            when Iir_Kind_Choice_By_Range =>
               --  LRM93 8.4
               --  It is an error if an element association in such an
               --  aggregate contains an OTHERS choice or a choice that is
               --  a discrete range.
               Error_Msg_Sem
                 (+Choice, "discrete range choice not allowed for target");
            when Iir_Kind_Choice_By_Others =>
               --  LRM93 8.4
               --  It is an error if an element association in such an
               --  aggregate contains an OTHERS choice or a choice that is
               --  a discrete range.
               Error_Msg_Sem
                 (+Choice, "others choice not allowed for target");
            when Iir_Kind_Choice_By_Expression
              | Iir_Kind_Choice_By_Name
              | Iir_Kind_Choice_By_None =>
               --  LRM93 9.4
               --  Such a target may not only contain locally static signal
               --  names [...]
               Ass := Get_Associated_Expr (Choice);
               if Get_Kind (Ass) = Iir_Kind_Aggregate then
                  Check_Aggregate_Target (Stmt, Ass, Nbr);
               else
                  if Get_Kind (Stmt) in
                    Iir_Kinds_Variable_Assignment_Statement
                  then
                     Check_Simple_Variable_Target (Stmt, Ass, Locally);
                  else
                     Check_Simple_Signal_Target (Stmt, Ass, Locally);
                  end if;
                  Nbr := Nbr + 1;
               end if;
            when others =>
               Error_Kind ("check_aggregate_target", Choice);
         end case;
         Choice := Get_Chain (Choice);
      end loop;
   end Check_Aggregate_Target;

   procedure Check_Simple_Signal_Target
     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness)
   is
      Target_Object : Iir;
      Target_Prefix : Iir;
      Guarded_Target : Tri_State_Type;
      Targ_Obj_Kind : Iir_Kind;
   begin
      Target_Object := Name_To_Object (Target);
      if Target_Object = Null_Iir then
         if Get_Kind (Target) = Iir_Kind_Simple_Name
           and then Is_Error (Get_Named_Entity (Target))
         then
            --  Common case: target is not declared.  There was already
            --  an error message for it.
            return;
         end if;

         --  Uncommon case: target is not an object (could be a component).
         Error_Msg_Sem (+Target, "target is not a signal name");
         return;
      end if;

      Target_Prefix := Get_Object_Prefix (Target_Object);
      Targ_Obj_Kind := Get_Kind (Target_Prefix);
      case Targ_Obj_Kind is
         when Iir_Kind_Interface_Signal_Declaration =>
            if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
               Error_Msg_Sem
                 (+Target, "%n can't be assigned", +Target_Prefix);
            else
               Sem_Add_Driver (Target_Object, Stmt);
            end if;
         when Iir_Kind_Signal_Declaration =>
            Sem_Add_Driver (Target_Object, Stmt);
            Set_Use_Flag (Target_Prefix, True);
         when Iir_Kind_Guard_Signal_Declaration =>
            Error_Msg_Sem (+Stmt, "implicit GUARD signal cannot be assigned");
            return;
         when others =>
            Error_Msg_Sem
              (+Stmt, "target (%n) is not a signal", +Get_Base_Name (Target));
            return;
      end case;
      if Get_Name_Staticness (Target_Object) < Staticness then
         Error_Msg_Sem (+Stmt, "signal name must be static");
      end if;

      --  LRM93 2.1.1.2
      --  A formal signal parameter is a guarded signal if and only if
      --  it is associated with an actual signal that is a guarded
      --  signal.
      --  GHDL: a formal signal interface of a subprogram has no static
      --   kind.  This is determined at run-time, according to the actual
      --   associated with the formal.
      --  GHDL: parent of target cannot be a function.
      if Targ_Obj_Kind = Iir_Kind_Interface_Signal_Declaration
        and then Is_Parameter (Target_Prefix)
      then
         Guarded_Target := Unknown;
      else
         if Get_Guarded_Signal_Flag (Target_Prefix) then
            Guarded_Target := True;
         else
            Guarded_Target := False;
         end if;
      end if;

      case Get_Guarded_Target_State (Stmt) is
         when Unknown =>
            Set_Guarded_Target_State (Stmt, Guarded_Target);
         when True
           | False =>
            if Get_Guarded_Target_State (Stmt) /= Guarded_Target then
               --  LRM93 9.5
               --  It is an error if the target of a concurrent signal
               --  assignment is neither a guarded target nor an
               --  unguarded target.
               Error_Msg_Sem (+Target, "guarded and unguarded target");
            end if;
      end case;
   end Check_Simple_Signal_Target;

   procedure Check_Simple_Variable_Target
     (Stmt : Iir; Target : Iir; Staticness : Iir_Staticness)
   is
      Target_Object : Iir;
      Target_Prefix : Iir;
   begin
      Target_Object := Name_To_Object (Target);
      if Target_Object = Null_Iir then
         Error_Msg_Sem (+Stmt, "target is not a variable name");
         return;
      end if;
      Target_Prefix := Get_Object_Prefix (Target_Object);
      case Get_Kind (Target_Prefix) is
         when Iir_Kind_Interface_Variable_Declaration =>
            if not Iir_Mode_Writable (Get_Mode (Target_Prefix)) then
               Error_Msg_Sem (+Target, "%n cannot be written (bad mode)",
                              +Target_Prefix);
               return;
            end if;
         when Iir_Kind_Variable_Declaration =>
            Set_Use_Flag (Target_Prefix, True);
         when Iir_Kind_Implicit_Dereference
           | Iir_Kind_Dereference  =>
            --  LRM 3.3
            --  An object designated by an access type is always an object of
            --  class variable.
            null;
         when Iir_Kind_Free_Quantity_Declaration
           | Iir_Kinds_Branch_Quantity_Declaration
           | Iir_Kind_Dot_Attribute =>
            if (Get_Kind (Get_Current_Concurrent_Statement)
                  /= Iir_Kind_Simultaneous_Procedural_Statement)
            then
               Error_Msg_Sem (+Stmt, "%n cannot be assigned", +Target_Prefix);
            end if;
         when others =>
            Error_Msg_Sem (+Stmt, "%n is not a variable to be assigned",
                           +Target_Prefix);
            return;
      end case;
      if Get_Name_Staticness (Target_Object) < Staticness then
         Error_Msg_Sem
           (+Target, "element of a target aggregate must be a static name");
      end if;
   end Check_Simple_Variable_Target;

   procedure Check_Target (Stmt : Iir; Target : Iir)
   is
      Nbr : Natural;
   begin
      if Get_Kind (Target) = Iir_Kind_Aggregate then
         Nbr := 0;
         Check_Aggregate_Target (Stmt, Target, Nbr);
         Check_Uniq_Aggregate_Associated (Target, Nbr);
      else
         case Get_Kind (Stmt) is
            when Iir_Kind_Variable_Assignment_Statement
              | Iir_Kind_Conditional_Variable_Assignment_Statement =>
               Check_Simple_Variable_Target (Stmt, Target, None);
            when others =>
               Check_Simple_Signal_Target (Stmt, Target, None);
         end case;
      end if;
   end Check_Target;

   type Resolve_Stages is (Resolve_Stage_1, Resolve_Stage_2);
   pragma Unreferenced (Resolve_Stage_2);

   procedure Sem_Signal_Assignment_Target_And_Option
     (Stmt: Iir; Sig_Type : in out Iir)
   is
      --  The target of the assignment.
      Target: Iir;
      --  The value that will be assigned.
      Expr: Iir;
   begin
      Target := Get_Target (Stmt);
      Target := Sem_Expression_Wildcard (Target, Get_Base_Type (Sig_Type));

      if Target /= Null_Iir then
         Set_Target (Stmt, Target);
         if Is_Expr_Fully_Analyzed (Target) then
            Check_Target (Stmt, Target);
            Sig_Type := Get_Type (Target);
            Sem_Types.Set_Type_Has_Signal (Sig_Type);
         end if;
      end if;

      Expr := Get_Reject_Time_Expression (Stmt);
      if Expr /= Null_Iir
        and then Is_Expr_Not_Analyzed (Expr)
      then
         Expr := Sem_Expression (Expr, Time_Type_Definition);
         if Expr /= Null_Iir then
            Check_Read (Expr);
            Set_Reject_Time_Expression (Stmt, Expr);
         end if;
      end if;
   end Sem_Signal_Assignment_Target_And_Option;

   --  Analyze a waveform_list WAVEFORM_LIST that is assigned via statement
   --  ASSIGN_STMT to a subelement or a slice of a signal SIGNAL_DECL.
   procedure Sem_Waveform_Chain (Waveform_Chain : Iir_Waveform_Element;
                                 Waveform_Type : in out Iir)
   is
      Expr: Iir;
      We: Iir_Waveform_Element;
      Time, Last_Time : Int64;
   begin
      if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then
         --  Unaffected.
         return;
      end if;

      --  Start with -1 to allow after 0 ns.
      Last_Time := -1;
      We := Waveform_Chain;
      while We /= Null_Iir loop
         Expr := Get_We_Value (We);
         if Get_Kind (Expr) = Iir_Kind_Null_Literal then
            --  GHDL: allowed only if target is guarded; this is checked by
            --  sem_check_waveform_list.
            null;
         else
            Expr := Sem_Expression_Wildcard (Expr, Waveform_Type, True);

            if Expr /= Null_Iir then
               if Is_Expr_Fully_Analyzed (Expr) then
                  Check_Read (Expr);
                  Expr := Eval_Expr_If_Static (Expr);
               end if;
               Set_We_Value (We, Expr);

               Merge_Wildcard_Type (Expr, Waveform_Type);
            else
               Expr := Get_We_Value (We);
               Expr := Create_Error_Expr (Expr, Waveform_Type);
               Set_We_Value (We, Expr);
            end if;
         end if;

         --  Analyze time expression.
         if Get_Time (We) /= Null_Iir then
            Expr := Get_Time (We);
            if Is_Expr_Not_Analyzed (Expr) then
               Expr := Sem_Expression (Expr, Time_Type_Definition);
               if Expr /= Null_Iir then
                  Set_Time (We, Expr);
                  Check_Read (Expr);

                  if Get_Expr_Staticness (Expr) = Locally
                    or else (Get_Kind (Expr) = Iir_Kind_Physical_Int_Literal
                               and then Flags.Flag_Time_64)
                  then
                     --  LRM 8.4
                     --  It is an error if the time expression in a waveform
                     --  element evaluates to a negative value.
                     --
                     --  LRM 8.4.1
                     --  It is an error if the sequence of new transactions is
                     --  not in ascending order with repect to time.
                     -- GHDL: this must be checked at run-time, but this is
                     --  also checked now for static expressions.
                     if Get_Expr_Staticness (Expr) = Locally then
                        --  The expression is static, and therefore may be
                        --  evaluated.
                        Expr := Eval_Expr (Expr);
                        Set_Time (We, Expr);
                        Time := Get_Value (Expr);
                     else
                        --  The expression is a physical literal (common case).
                        --  Extract its value.
                        Time := Get_Physical_Value (Expr);
                     end if;
                     if Time < 0 then
                        Error_Msg_Sem
                          (+Expr, "waveform time expression must be >= 0");
                     elsif Time <= Last_Time then
                        Error_Msg_Sem
                          (+Expr,
                           "time must be greather than previous transaction");
                     else
                        Last_Time := Time;
                     end if;
                  end if;
               end if;
            end if;
         else
            if We /= Waveform_Chain then
               --  Time expression must be in ascending order.
               Error_Msg_Sem (+We, "time expression required here");
            end if;

            --  LRM93 12.6.4
            --  It is an error if the execution of any postponed process
            --  causes a delta cycle to occur immediatly after the current
            --  simulation cycle.
            --  GHDL: try to warn for such an error; note the context may be
            --   a procedure body.
            if Current_Concurrent_Statement /= Null_Iir then
               case Get_Kind (Current_Concurrent_Statement) is
                  when Iir_Kind_Sensitized_Process_Statement
                    | Iir_Kind_Process_Statement
                    | Iir_Kind_Concurrent_Conditional_Signal_Assignment
                    | Iir_Kind_Concurrent_Selected_Signal_Assignment =>
                     if Get_Postponed_Flag (Current_Concurrent_Statement) then
                        Warning_Msg_Sem
                          (Warnid_Delta_Cycle, +We,
                           "waveform may cause a delta cycle in a " &
                             "postponed process");
                     end if;
                  when others =>
                     --  Context is a subprogram.
                     null;
               end case;
            end if;

            Last_Time := 0;
         end if;

         We := Get_Chain (We);
      end loop;
   end Sem_Waveform_Chain;

   --  Analyze a waveform chain WAVEFORM_CHAIN that is assigned via statement
   --  ASSIGN_STMT to a subelement or a slice of a signal SIGNAL_DECL.
   procedure Sem_Check_Waveform_Chain
     (Assign_Stmt: Iir; Waveform_Chain: Iir_Waveform_Element)
   is
      We: Iir_Waveform_Element;
      Expr : Iir;
      Targ_Type : Iir;
   begin
      if Get_Kind (Waveform_Chain) = Iir_Kind_Unaffected_Waveform then
         return;
      end if;

      Targ_Type := Get_Type (Get_Target (Assign_Stmt));

      We := Waveform_Chain;
      while We /= Null_Iir loop
         Expr := Get_We_Value (We);
         if Get_Kind (Expr) = Iir_Kind_Null_Literal then
            --  This is a null waveform element.
            --  LRM93 8.4.1
            --  It is an error if the target of a signal assignment statement
            --  containing a null waveform is not a guarded signal or an
            --  aggregate of guarded signals.
            if Get_Guarded_Target_State (Assign_Stmt) = False then
               Error_Msg_Sem
                 (+Assign_Stmt,
                  "null transactions can be assigned only to guarded signals");
            end if;
         else
            if Is_Valid (Get_Type (Expr))
              and then not Eval_Is_In_Bound (Expr, Targ_Type)
              and then Get_Kind (Expr) /= Iir_Kind_Overflow_Literal
            then
               Warning_Msg_Sem
                 (Warnid_Runtime_Error, +We,
                  "value constraints don't match target ones");
               Set_We_Value (We, Build_Overflow (Expr, Targ_Type));
            end if;
         end if;
         We := Get_Chain (We);
      end loop;
   end Sem_Check_Waveform_Chain;

   procedure Sem_Guard (Stmt: Iir)
   is
      Guard: Iir;
      Guard_Interpretation : Name_Interpretation_Type;
   begin
      Guard := Get_Guard (Stmt);
      if Guard = Null_Iir then
         --  This assignment is not guarded.

         --  LRM93 9.5
         --  It is an error if a concurrent signal assignment is not a guarded
         --  assignment, and the target of the concurrent signal assignment
         --  is a guarded target.
         if Get_Guarded_Target_State (Stmt) = True then
            Error_Msg_Sem
              (+Stmt, "not a guarded assignment for a guarded target");
         end if;
         return;
      end if;
      if Guard /= Stmt then
         -- if set, guard must be equal to stmt here.
         raise Internal_Error;
      end if;
      Guard_Interpretation := Get_Interpretation (Std_Names.Name_Guard);
      if not Valid_Interpretation (Guard_Interpretation) then
         Error_Msg_Sem (+Stmt, "no guard signals for this guarded assignment");
         return;
      end if;

      Guard := Get_Declaration (Guard_Interpretation);
      -- LRM93 9.5:
      -- The signal GUARD [...] an explicitly declared signal of type
      -- BOOLEAN that is visible at the point of the concurrent signal
      -- assignment statement
      -- FIXME.
      case Get_Kind (Guard) is
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Guard_Signal_Declaration =>
            null;
         when others =>
            Report_Start_Group;
            Error_Msg_Sem (+Stmt, "visible GUARD object is not a signal");
            Error_Msg_Sem (+Stmt, "GUARD object is %n", +Guard);
            Report_End_Group;
            return;
      end case;

      if Get_Type (Guard) /= Boolean_Type_Definition then
         Error_Msg_Sem (+Guard, "GUARD is not of boolean type");
      end if;
      Set_Guard (Stmt, Guard);
   end Sem_Guard;

   --  Analyze optional Condition field of PARENT.
   procedure Sem_Condition_Opt (Parent : Iir)
   is
      Cond : Iir;
   begin
      Cond := Get_Condition (Parent);
      if Cond /= Null_Iir then
         Cond := Sem_Condition (Cond);
         if Cond /= Null_Iir then
            Set_Condition (Parent, Cond);
         end if;
      end if;
   end Sem_Condition_Opt;

   procedure Sem_Signal_Assignment (Stmt: Iir)
   is
      Cond_Wf : Iir_Conditional_Waveform;
      Wf_Chain : Iir_Waveform_Element;
      Target_Type : Iir;
      Done : Boolean;
   begin
      Target_Type := Wildcard_Any_Type;

      Done := False;
      for S in Resolve_Stages loop
         Sem_Signal_Assignment_Target_And_Option (Stmt, Target_Type);
         if Is_Defined_Type (Target_Type) then
            Done := True;
         end if;

         case Get_Kind (Stmt) is
            when Iir_Kind_Concurrent_Simple_Signal_Assignment
              | Iir_Kind_Simple_Signal_Assignment_Statement =>
               Wf_Chain := Get_Waveform_Chain (Stmt);
               Sem_Waveform_Chain (Wf_Chain, Target_Type);
               if Done then
                  Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
               end if;

            when Iir_Kind_Concurrent_Conditional_Signal_Assignment
              | Iir_Kind_Conditional_Signal_Assignment_Statement =>
               Cond_Wf := Get_Conditional_Waveform_Chain (Stmt);
               while Cond_Wf /= Null_Iir loop
                  Wf_Chain := Get_Waveform_Chain (Cond_Wf);
                  Sem_Waveform_Chain (Wf_Chain, Target_Type);
                  if Done then
                     Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
                  end if;
                  if S = Resolve_Stage_1 then
                     --  Must be analyzed only once.
                     Sem_Condition_Opt (Cond_Wf);
                  end if;
                  Cond_Wf := Get_Chain (Cond_Wf);
               end loop;

            when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
               declare
                  El : Iir;
               begin
                  El := Get_Selected_Waveform_Chain (Stmt);
                  while El /= Null_Iir loop
                     Wf_Chain := Get_Associated_Chain (El);
                     if Is_Valid (Wf_Chain) then
                        --  The first choice of a list.
                        Sem_Waveform_Chain (Wf_Chain, Target_Type);
                        if Done then
                           Sem_Check_Waveform_Chain (Stmt, Wf_Chain);
                        end if;
                     end if;
                     El := Get_Chain (El);
                  end loop;
               end;

            when others =>
               raise Internal_Error;
         end case;

         exit when Done;
         if not Is_Defined_Type (Target_Type) then
            Error_Msg_Sem (+Stmt, "cannot resolve type of waveform");
            exit;
         end if;
      end loop;

      case Get_Kind (Stmt) is
         when Iir_Kind_Concurrent_Simple_Signal_Assignment
           | Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
            Sem_Guard (Stmt);
         when others =>
            null;
      end case;
   end Sem_Signal_Assignment;

   procedure Sem_Conditional_Expression_Chain
     (Cond_Expr : Iir; Atype : in out Iir)
   is
      El : Iir;
      Expr : Iir;
      Cond : Iir;
   begin
      El := Cond_Expr;
      while El /= Null_Iir loop
         Expr := Get_Expression (El);
         Expr := Sem_Expression_Wildcard (Expr, Atype, True);

         if Expr /= Null_Iir then
            Set_Expression (El, Expr);

            if Is_Expr_Fully_Analyzed (Expr) then
               Check_Read (Expr);
               Expr := Eval_Expr_If_Static (Expr);
            end if;

            Merge_Wildcard_Type (Expr, Atype);
         end if;

         Cond := Get_Condition (El);
         exit when Cond = Null_Iir;

         if Is_Expr_Not_Analyzed (Cond) then
            Cond := Sem_Condition (Cond);
            Set_Condition (El, Cond);
         end if;

         El := Get_Chain (El);
      end loop;
   end Sem_Conditional_Expression_Chain;

   procedure Sem_Variable_Assignment (Stmt: Iir)
   is
      Target : Iir;
      Expr : Iir;
      Target_Type : Iir;
      Stmt_Type : Iir;
      Done : Boolean;
   begin
      --  LRM93 8.5 Variable assignment statement
      --  If the target of the variable assignment statement is in the form of
      --  an aggregate, then the type of the aggregate must be determinable
      --  from the context, excluding the aggregate itself but including the
      --  fact that the type of the aggregate must be a composite type.  The
      --  base type of the expression on the right-hand side must be the
      --  same as the base type of the aggregate.
      --
      --  GHDL: this means that the type can only be deduced from the
      --  expression (and not from the target).

      Target := Get_Target (Stmt);
      Stmt_Type := Wildcard_Any_Type;
      for S in Resolve_Stages loop
         Done := False;

         Target := Sem_Expression_Wildcard (Target, Stmt_Type);
         if Target = Null_Iir then
            Target_Type := Stmt_Type;
         else
            Set_Target (Stmt, Target);
            if Is_Expr_Fully_Analyzed (Target) then
               Check_Target (Stmt, Target);
               Done := True;
            end if;
            Target_Type := Get_Type (Target);
            Stmt_Type := Target_Type;
         end if;

         case Iir_Kinds_Variable_Assignment_Statement (Get_Kind (Stmt)) is
            when Iir_Kind_Variable_Assignment_Statement =>
               Expr := Get_Expression (Stmt);
               Expr := Sem_Expression_Wildcard (Expr, Stmt_Type, True);
               if Expr /= Null_Iir then
                  if Is_Expr_Fully_Analyzed (Expr) then
                     Check_Read (Expr);
                     Expr := Eval_Expr_If_Static (Expr);
                  end if;
                  Set_Expression (Stmt, Expr);
                  Merge_Wildcard_Type (Expr, Stmt_Type);
                  if Done
                    and then not Eval_Is_In_Bound (Expr, Target_Type)
                    and then Get_Kind (Expr) /= Iir_Kind_Overflow_Literal
                  then
                     Warning_Msg_Sem
                       (Warnid_Runtime_Error, +Stmt,
                        "expression constraints don't match target ones");
                     Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
                  end if;
               end if;

            when Iir_Kind_Conditional_Variable_Assignment_Statement =>
               Expr := Get_Conditional_Expression_Chain (Stmt);
               Sem_Conditional_Expression_Chain (Expr, Stmt_Type);
         end case;

         exit when Done;
         if not Is_Defined_Type (Stmt_Type) then
            Error_Msg_Sem (+Stmt, "cannot resolve type");
            if Get_Kind (Target) = Iir_Kind_Aggregate then
               --  Try to give an advice.
               Error_Msg_Sem (+Stmt, "use a qualified expression for the RHS");
            end if;
            exit;
         end if;
      end loop;
   end Sem_Variable_Assignment;

   procedure Sem_Return_Statement (Stmt: Iir_Return_Statement) is
      Expr: Iir;
   begin
      if Current_Subprogram = Null_Iir then
         Error_Msg_Sem (+Stmt, "return statement not in a subprogram body");
         return;
      end if;
      Expr := Get_Expression (Stmt);
      case Get_Kind (Current_Subprogram) is
         when Iir_Kind_Procedure_Declaration =>
            if Expr /= Null_Iir then
               Error_Msg_Sem
                 (+Stmt, "return in a procedure can't have an expression");
            end if;
            return;
         when Iir_Kind_Function_Declaration =>
            if Expr = Null_Iir then
               Error_Msg_Sem
                 (+Stmt, "return in a function must have an expression");
               return;
            end if;
         when Iir_Kinds_Process_Statement =>
            Error_Msg_Sem (+Stmt, "return statement not allowed in a process");
            return;
         when others =>
            Error_Kind ("sem_return_statement", Stmt);
      end case;
      Set_Type (Stmt, Get_Return_Type (Current_Subprogram));
      Expr := Sem_Expression (Expr, Get_Return_Type (Current_Subprogram));
      if Expr /= Null_Iir then
         Check_Read (Expr);
         Set_Expression (Stmt, Eval_Expr_If_Static (Expr));
      end if;
   end Sem_Return_Statement;

   procedure Sem_Report_Expression (Stmt : Iir)
   is
      Expr : Iir;
   begin
      Expr := Get_Report_Expression (Stmt);
      if Expr /= Null_Iir then
         Expr := Sem_Expression (Expr, String_Type_Definition);
         Check_Read (Expr);
         Expr := Eval_Expr_If_Static (Expr);
         Set_Report_Expression (Stmt, Expr);
      end if;
   end Sem_Report_Expression;

   -- Sem for concurrent and sequential assertion statements.
   procedure Sem_Report_Statement (Stmt : Iir)
   is
      Expr : Iir;
   begin
      Sem_Report_Expression (Stmt);

      Expr := Get_Severity_Expression (Stmt);
      if Expr /= Null_Iir then
         Expr := Sem_Expression (Expr, Severity_Level_Type_Definition);
         Check_Read (Expr);
         Set_Severity_Expression (Stmt, Expr);
      end if;
   end Sem_Report_Statement;

   procedure Sem_Assertion_Statement (Stmt: Iir)
   is
      Expr : Iir;
   begin
      Expr := Get_Assertion_Condition (Stmt);
      Expr := Sem_Condition (Expr);
      Expr := Eval_Expr_If_Static (Expr);
      Set_Assertion_Condition (Stmt, Expr);

      Sem_Report_Statement (Stmt);
   end Sem_Assertion_Statement;

   --  Analyze a list of case choice LIST, and check for correct CHOICE type.
   procedure Sem_Case_Choices
     (Choice : Iir; Chain : in out Iir; Loc : Location_Type)
   is
      --  Check restrictions on the expression of a One-Dimensional Character
      --  Array Type (ODCAT) given by LRM 8.8
      --  Return FALSE in case of violation.
      function Check_Odcat_Expression (Expr : Iir) return Boolean
      is
         Expr_Type : constant Iir := Get_Type (Expr);
      begin
         --  LRM 8.8 Case Statement
         --  If the expression is of a one-dimensional character array type,
         --  then the expression must be one of the following:
         case Get_Kind (Expr) is
            when Iir_Kinds_Object_Declaration
              | Iir_Kind_Selected_Element =>
               --  FIXME: complete the list.
               --  * the name of an object whose subtype is locally static.
               if Get_Type_Staticness (Expr_Type) /= Locally then
                  Error_Msg_Sem
                    (+Choice, "object subtype is not locally static");
                  return False;
               end if;
            when Iir_Kind_Indexed_Name =>
               --  LRM93
               --  * an indexed name whose prefix is one of the members of
               --    this list and whose indexing expressions are locally
               --    static expression.
               if Flags.Vhdl_Std = Vhdl_87 then
                  Error_Msg_Sem
                    (+Expr, "indexed name not allowed here in vhdl87");
                  return False;
               end if;
               if not Check_Odcat_Expression (Get_Prefix (Expr)) then
                  return False;
               end if;
               --  GHDL: I don't understand why the indexing expressions
               --  must be locally static.  So I don't check this in 93c.
               if Flags.Vhdl_Std /= Vhdl_93c
                 and then
                 (Get_Expr_Staticness
                    (Get_Nth_Element (Get_Index_List (Expr), 0)) /= Locally)
               then
                  Error_Msg_Sem
                    (+Expr, "indexing expression must be locally static");
                  return False;
               end if;
            when Iir_Kind_Slice_Name =>
               --  LRM93
               --  * a slice name whose prefix is one of the members of this
               --    list and whose discrete range is a locally static
               --    discrete range.

               --  LRM87/INT1991 IR96
               --  then the expression must be either a slice name whose
               --  discrete range is locally static, or ..
               if False and Flags.Vhdl_Std = Vhdl_87 then
                  Error_Msg_Sem
                    (+Expr, "slice not allowed as case expression in vhdl87");
                  return False;
               end if;
               if not Check_Odcat_Expression (Get_Prefix (Expr)) then
                  return False;
               end if;
               if Get_Type_Staticness (Expr_Type) /= Locally then
                  Error_Msg_Sem
                    (+Expr, "slice discrete range must be locally static");
                  return False;
               end if;
            when Iir_Kind_Function_Call =>
               --  LRM93
               --  * a function call whose return type mark denotes a
               --    locally static subtype.
               if Flags.Vhdl_Std = Vhdl_87 then
                  Error_Msg_Sem
                    (+Expr, "function call not allowed here in vhdl87");
                  return False;
               end if;
               if Get_Type_Staticness (Expr_Type) /= Locally then
                  Error_Msg_Sem
                    (+Expr, "function call type is not locally static");
               end if;
            when Iir_Kind_Qualified_Expression
              | Iir_Kind_Type_Conversion =>
               --  * a qualified expression or type conversion whose type mark
               --    denotes a locally static subtype.
               if Get_Type_Staticness (Expr_Type) /= Locally then
                  Error_Msg_Sem
                    (+Expr, "type mark is not a locally static subtype");
                  return False;
               end if;
            when Iir_Kind_Simple_Name
              | Iir_Kind_Selected_Name =>
               return Check_Odcat_Expression (Get_Named_Entity (Expr));
            when others =>
               Error_Msg_Sem
                 (+Choice, "bad form of case expression (refer to LRM 8.8)");
               return False;
         end case;
         return True;
      end Check_Odcat_Expression;

      Choice_Type : constant Iir := Get_Type (Choice);
      Low, High : Iir;
      El_Type : Iir;
   begin
      --  LRM 8.8  Case Statement
      --  The expression must be of a discrete type, or of a one-dimensional
      --  array type whose element base type is a character type.
      case Get_Kind (Choice_Type) is
         when Iir_Kinds_Discrete_Type_Definition =>
            Sem_Choices_Range
              (Chain, Choice_Type, Low, High, Loc, False, True);
         when Iir_Kind_Array_Subtype_Definition
           | Iir_Kind_Array_Type_Definition =>
            if not Is_One_Dimensional_Array_Type (Choice_Type) then
               Error_Msg_Sem
                 (+Choice,
                  "expression must be of a one-dimensional array type");
               return;
            end if;
            El_Type := Get_Base_Type (Get_Element_Subtype (Choice_Type));
            if Get_Kind (El_Type) /= Iir_Kind_Enumeration_Type_Definition
              or else not Get_Is_Character_Type (El_Type)
            then
               Error_Msg_Sem
                 (+Choice,
                  "element type of the expression must be a character type");
               return;
            end if;
            if Flags.Vhdl_Std >= Vhdl_08 then
               --  No specific restrictions in vhdl 2008.
               null;
            elsif Flags.Flag_Relaxed_Rules then
               --  In relaxed mode, only check staticness of the expression
               --  subtype, as the type of a prefix may not be locally static
               --  while the type of the expression is.
               if Get_Type_Staticness (Choice_Type) /= Locally then
                  Error_Msg_Sem
                    (+Choice, "choice subtype is not locally static");
                  return;
               end if;
            else
               if not Check_Odcat_Expression (Choice) then
                  return;
               end if;
            end if;
            Sem_String_Choices_Range (Chain, Choice);
         when others =>
            Error_Msg_Sem (+Choice, "type of expression must be discrete");
      end case;
   end Sem_Case_Choices;

   procedure Sem_Case_Statement (Stmt: Iir_Case_Statement)
   is
      Expr: Iir;
      Chain : Iir;
      El: Iir;
   begin
      Expr := Get_Expression (Stmt);
      Chain := Get_Case_Statement_Alternative_Chain (Stmt);
      -- FIXME: overload.
      Expr := Sem_Case_Expression (Expr);
      if Expr /= Null_Iir then
         Check_Read (Expr);
         Set_Expression (Stmt, Expr);

         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
         Set_Case_Statement_Alternative_Chain (Stmt, Chain);
      end if;

      El := Chain;
      while El /= Null_Iir loop
         if not Get_Same_Alternative_Flag (El) then
            Sem_Sequential_Statements_Internal (Get_Associated_Chain (El));
         end if;
         El := Get_Chain (El);
      end loop;
   end Sem_Case_Statement;

   --  Sem the sensitivity list LIST.
   procedure Sem_Sensitivity_List (List: Iir_List)
   is
      El: Iir;
      It : List_Iterator;
      Res: Iir;
      Prefix : Iir;
   begin
      if List = Iir_List_All then
         return;
      end if;

      It := List_Iterate (List);
      while Is_Valid (It) loop
         -- El is an iir_identifier.
         El := Get_Element (It);

         if Is_Error (El) then
            pragma Assert (Flags.Flag_Force_Analysis);
            Res := Error_Mark;
         else
            Sem_Name (El);

            Res := Get_Named_Entity (El);
         end if;

         if Res = Error_Mark then
            null;
         elsif Is_Overload_List (Res) or else not Is_Object_Name (Res) then
            Error_Msg_Sem (+El, "a sensitivity element must be a signal name");
         else
            Res := Finish_Sem_Name (El);
            Prefix := Get_Object_Prefix (Res);
            case Get_Kind (Prefix) is
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Guard_Signal_Declaration
                 | Iir_Kinds_Signal_Attribute
                 | Iir_Kind_Above_Attribute =>
                  null;
               when Iir_Kind_Interface_Signal_Declaration =>
                  if not Is_Interface_Signal_Readable (Prefix) then
                     Error_Msg_Sem
                       (+El,
                        "%n of mode out can't be in a sensivity list", +Res);
                  end if;
               when others =>
                  Error_Msg_Sem (+El,
                                 "%n is neither a signal nor a port", +Res);
            end case;
            --  LRM 9.2
            --  Only static signal names (see section 6.1) for which reading
            --  is permitted may appear in the sensitivity list of a process
            --  statement.

            --  LRM 8.1  Wait statement
            --  Each signal name in the sensitivity list must be a static
            --  signal name, and each name must denote a signal for which
            --  reading is permitted.
            if Get_Name_Staticness (Res) < Globally then
               Error_Msg_Sem
                 (+El, "sensitivity element %n must be a static name", +Res);
            end if;

            Set_Element (It, Res);
         end if;

         Next (It);
      end loop;
   end Sem_Sensitivity_List;

   --  Mark STMT and its parents as suspendable.
   procedure Mark_Suspendable (Stmt : Iir)
   is
      Parent : Iir;
   begin
      Parent := Get_Parent (Stmt);
      loop
         case Get_Kind (Parent) is
            when Iir_Kind_Function_Body
              | Iir_Kind_Sensitized_Process_Statement =>
               exit;
            when Iir_Kind_Process_Statement
              | Iir_Kind_Procedure_Body =>
               Set_Suspend_Flag (Parent, True);
               exit;
            when Iir_Kind_If_Statement
              | Iir_Kind_While_Loop_Statement
              | Iir_Kind_For_Loop_Statement
              | Iir_Kind_Case_Statement =>
               Set_Suspend_Flag (Parent, True);
               Parent := Get_Parent (Parent);
            when others =>
               Error_Kind ("mark_suspendable", Parent);
         end case;
      end loop;
   end Mark_Suspendable;

   function Sem_Real_Or_Time_Timeout (Expr : Iir) return Iir
   is
      Res : Iir;
      Res_Type : Iir;
   begin
      Res := Sem_Expression_Ov (Expr, Null_Iir);

      if Res = Null_Iir then
         --  Error occurred.
         return Res;
      end if;

      Res_Type := Get_Type (Res);
      if not Is_Overload_List (Res_Type) then
         Res_Type := Get_Base_Type (Get_Type (Res));
         if Res_Type = Time_Type_Definition
           or else Res_Type = Real_Type_Definition
         then
            Check_Read (Res);
            return Res;
         else
            Error_Msg_Sem
              (+Expr, "timeout expression must be of type time or real");
            return Expr;
         end if;
      else
         --  Many interpretations.
         declare
            Res_List : constant Iir_List := Get_Overload_List (Res_Type);
            It : List_Iterator;
            El : Iir;
            Nbr_Res : Natural;
         begin
            Nbr_Res := 0;

            --  Extract boolean interpretations.
            It := List_Iterate (Res_List);
            while Is_Valid (It) loop
               El := Get_Base_Type (Get_Element (It));
               if Are_Basetypes_Compatible (El, Time_Type_Definition)
                 /= Not_Compatible
               then
                  Res_Type := Time_Type_Definition;
                  Nbr_Res := Nbr_Res + 1;
               elsif Are_Basetypes_Compatible (El, Real_Type_Definition)
                 /= Not_Compatible
               then
                  Res_Type := Real_Type_Definition;
                  Nbr_Res := Nbr_Res + 1;
               end if;
               Next (It);
            end loop;

            if Nbr_Res = 1 then
               Res := Sem_Expression_Ov (Expr, Res_Type);
               Check_Read (Res);
               return Res;
            else
               Error_Overload (Expr);
               return Expr;
            end if;
         end;
      end if;
   end Sem_Real_Or_Time_Timeout;

   procedure Sem_Wait_Statement (Stmt: Iir_Wait_Statement)
   is
      Expr: Iir;
      Sensitivity_List : Iir_List;
   begin
      --  Check validity.
      case Get_Kind (Current_Subprogram) is
         when Iir_Kind_Process_Statement =>
            null;
         when Iir_Kind_Function_Declaration =>
            --  LRM93 8.2
            --  It is an error if a wait statement appears in a function
            --  subprogram [...]
            Error_Msg_Sem
              (+Stmt, "wait statement not allowed in a function subprogram");
            return;
         when Iir_Kind_Procedure_Declaration =>
            --  LRM93 8.2
            --  [It is an error ...] or in a procedure that has a parent that
            --  is a function subprogram.
            --  LRM93 8.2
            --  [...] or in a procedure that has a parent that is such a
            --  process statement.
            -- GHDL: this is checked at the end of analysis or during
            --  elaboration.
            Set_Wait_State (Current_Subprogram, True);
         when Iir_Kind_Sensitized_Process_Statement =>
            --  LRM93 8.2
            --  Furthermore, it is an error if a wait statement appears in an
            --  explicit process statement that includes a sensitivity list,
            --  [...]
            Error_Msg_Sem
              (+Stmt, "wait statement not allowed in a sensitized process");
            return;
         when others =>
            raise Internal_Error;
      end case;

      Sensitivity_List := Get_Sensitivity_List (Stmt);
      if Sensitivity_List /= Null_Iir_List then
         Sem_Sensitivity_List (Sensitivity_List);
      end if;

      Expr := Get_Condition_Clause (Stmt);
      if Expr /= Null_Iir then
         Expr := Sem_Condition (Expr);
         Set_Condition_Clause (Stmt, Expr);
      end if;

      Expr := Get_Timeout_Clause (Stmt);
      if Expr /= Null_Iir then
         if AMS_Vhdl then
            Expr := Sem_Real_Or_Time_Timeout (Expr);
            Set_Timeout_Clause (Stmt, Expr);
         else
            Expr := Sem_Expression (Expr, Time_Type_Definition);
            if Expr /= Null_Iir then
               Check_Read (Expr);
               Expr := Eval_Expr_If_Static (Expr);
               Set_Timeout_Clause (Stmt, Expr);
               if Get_Expr_Staticness (Expr) = Locally
                 and then Get_Physical_Value (Expr) < 0
               then
                  Error_Msg_Sem (+Stmt, "timeout value must be positive");
               end if;
            end if;
         end if;
      end if;

      Mark_Suspendable (Stmt);
   end Sem_Wait_Statement;

   procedure Sem_Exit_Next_Statement (Stmt : Iir)
   is
      Loop_Label : Iir;
      Loop_Stmt: Iir;
      P : Iir;
   begin
      --  Analyze condition (if present).
      Sem_Condition_Opt (Stmt);

      --  Analyze label.
      Loop_Label := Get_Loop_Label (Stmt);
      if Loop_Label /= Null_Iir then
         Loop_Label := Sem_Denoting_Name (Loop_Label);
         Set_Loop_Label (Stmt, Loop_Label);
         Loop_Stmt := Get_Named_Entity (Loop_Label);
         case Get_Kind (Loop_Stmt) is
            when Iir_Kind_For_Loop_Statement
              | Iir_Kind_While_Loop_Statement =>
               null;
            when others =>
               Error_Class_Match (Loop_Label, "loop statement");
               Loop_Stmt := Null_Iir;
         end case;
      else
         Loop_Stmt := Null_Iir;
      end if;

      --  Check the current statement is inside the labeled loop.
      P := Stmt;
      loop
         P := Get_Parent (P);
         case Get_Kind (P) is
            when Iir_Kind_While_Loop_Statement
              | Iir_Kind_For_Loop_Statement =>
               if Loop_Stmt = Null_Iir or else P = Loop_Stmt then
                  case Iir_Kinds_Next_Exit_Statement (Get_Kind (Stmt)) is
                     when Iir_Kind_Next_Statement =>
                        Set_Next_Flag (P, True);
                     when Iir_Kind_Exit_Statement =>
                        Set_Exit_Flag (P, True);
                  end case;
                  exit;
               end if;
            when Iir_Kind_If_Statement
              | Iir_Kind_Elsif
              | Iir_Kind_Case_Statement =>
               null;
            when others =>
               --  FIXME: should emit a message for label mismatch.
               Error_Msg_Sem (+Stmt, "exit/next must be inside a loop");
               exit;
         end case;
      end loop;
   end Sem_Exit_Next_Statement;

   function Sem_Quantity_Name (Name : Iir) return Iir
   is
      Res : Iir;
   begin
      Sem_Name (Name);

      Res := Get_Named_Entity (Name);

      if Res = Error_Mark then
         return Null_Iir;
      elsif Is_Overload_List (Res) then
         Error_Msg_Sem (+Name, "quantity name expected");
         return Null_Iir;
      else
         Res := Finish_Sem_Name (Name);
         if not Is_Quantity_Name (Res) then
            Error_Msg_Sem (+Name, "%n is not a quantity name", +Res);
            return Null_Iir;
         else
            return Res;
         end if;
      end if;
   end Sem_Quantity_Name;

   procedure Sem_Break_List (First : Iir)
   is
      El : Iir;
      Name : Iir;
      Break_Quantity : Iir;
      Sel_Quantity : Iir;
      Expr : Iir;
      Expr_Type : Iir;
   begin
      El := First;
      while El /= Null_Iir loop
         Name := Get_Break_Quantity (El);
         Break_Quantity := Sem_Quantity_Name (Name);

         --  AMS-LRM17 10.15 Break statement
         --  The break quantity, the selector quantity, and the expression
         --  shall have the same type [...]
         if Break_Quantity /= Null_Iir then
            Set_Break_Quantity (El, Break_Quantity);
            Expr_Type := Get_Type (Break_Quantity);
         else
            Expr_Type := Null_Iir;
         end if;

         Expr := Get_Expression (El);
         Expr := Sem_Expression (Expr, Expr_Type);
         if Expr /= Null_Iir then
            Set_Expression (El, Expr);
         end if;

         Sel_Quantity := Get_Selector_Quantity (El);
         if Sel_Quantity /= Null_Iir then
            Sel_Quantity := Sem_Quantity_Name (Name);
            if Sel_Quantity /= Null_Iir and then Expr_Type /= Null_Iir then
               if Is_Expr_Compatible (Expr_Type, Sel_Quantity) = Not_Compatible
               then
                  Error_Msg_Sem (+Sel_Quantity,
                                 "selector quantity must be of the same type "
                                   & "as the break quantity");
               end if;
            end if;
         end if;

         El := Get_Chain (El);
      end loop;
   end Sem_Break_List;

   procedure Sem_Break_Statement (Stmt : Iir) is
   begin
      Sem_Break_List (Get_Break_Element (Stmt));

      Sem_Condition_Opt (Stmt);
   end Sem_Break_Statement;

   -- Process is the scope, this is also the process for which drivers can
   -- be created.
   procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir)
   is
      Stmt: Iir;
   begin
      Stmt := First_Stmt;
      while Stmt /= Null_Iir loop
         case Get_Kind (Stmt) is
            when Iir_Kind_Null_Statement =>
               null;
            when Iir_Kind_If_Statement =>
               declare
                  Clause: Iir := Stmt;
               begin
                  while Clause /= Null_Iir loop
                     Sem_Condition_Opt (Clause);
                     Sem_Sequential_Statements_Internal
                       (Get_Sequential_Statement_Chain (Clause));
                     Clause := Get_Else_Clause (Clause);
                  end loop;
               end;
            when Iir_Kind_For_Loop_Statement =>
               declare
                  Iterator : constant Iir :=
                    Get_Parameter_Specification (Stmt);
               begin
                  --  LRM 10.1 Declarative region
                  --  9. A loop statement.
                  Open_Declarative_Region;

                  Set_Is_Within_Flag (Stmt, True);
                  Sem_Scopes.Add_Name (Iterator);
                  Sem_Iterator (Iterator, None);
                  Set_Visible_Flag (Iterator, True);
                  Sem_Sequential_Statements_Internal
                    (Get_Sequential_Statement_Chain (Stmt));
                  Set_Is_Within_Flag (Stmt, False);

                  Close_Declarative_Region;
               end;
            when Iir_Kind_While_Loop_Statement =>
               Sem_Condition_Opt (Stmt);
               Sem_Sequential_Statements_Internal
                 (Get_Sequential_Statement_Chain (Stmt));
            when Iir_Kind_Simple_Signal_Assignment_Statement
              | Iir_Kind_Conditional_Signal_Assignment_Statement =>
               Sem_Signal_Assignment (Stmt);
               if Current_Concurrent_Statement /= Null_Iir and then
                 Get_Kind (Current_Concurrent_Statement)
                 in Iir_Kinds_Process_Statement
                 and then Get_Passive_Flag (Current_Concurrent_Statement)
               then
                  Error_Msg_Sem
                    (+Stmt, "signal statement forbidden in passive process");
               end if;
            when Iir_Kind_Variable_Assignment_Statement
              | Iir_Kind_Conditional_Variable_Assignment_Statement =>
               Sem_Variable_Assignment (Stmt);
            when Iir_Kind_Return_Statement =>
               Sem_Return_Statement (Stmt);
            when Iir_Kind_Assertion_Statement =>
               Sem_Assertion_Statement (Stmt);
            when Iir_Kind_Report_Statement =>
               Sem_Report_Statement (Stmt);
            when Iir_Kind_Case_Statement =>
               Sem_Case_Statement (Stmt);
            when Iir_Kind_Wait_Statement =>
               Sem_Wait_Statement (Stmt);
            when Iir_Kind_Break_Statement =>
               Sem_Break_Statement (Stmt);
            when Iir_Kind_Procedure_Call_Statement =>
               declare
                  Call : constant Iir := Get_Procedure_Call (Stmt);
                  Imp : Iir;
               begin
                  Sem_Procedure_Call (Call, Stmt);

                  --  Set suspend flag, if calling a suspendable procedure
                  --  from a procedure or from a process.
                  Imp := Get_Implementation (Call);
                  if Imp /= Null_Iir
                    and then Get_Kind (Imp) = Iir_Kind_Procedure_Declaration
                    and then Get_Suspend_Flag (Imp)
                    and then (Get_Kind (Get_Current_Subprogram)
                                /= Iir_Kind_Function_Declaration)
                    and then (Get_Kind (Get_Current_Subprogram)
                                /= Iir_Kind_Sensitized_Process_Statement)
                  then
                     Set_Suspend_Flag (Stmt, True);
                     Mark_Suspendable (Stmt);
                  end if;
               end;
            when Iir_Kind_Next_Statement
              | Iir_Kind_Exit_Statement =>
               Sem_Exit_Next_Statement (Stmt);
            when others =>
               Error_Kind ("sem_sequential_statements_Internal", Stmt);
         end case;
         Stmt := Get_Chain (Stmt);
      end loop;
   end Sem_Sequential_Statements_Internal;

   procedure Sem_Sequential_Statements (Decl : Iir; Body_Parent : Iir)
   is
      Outer_Subprogram: Iir;
   begin
      Outer_Subprogram := Current_Subprogram;
      Current_Subprogram := Decl;

      -- Sem declarations
      Sem_Sequential_Labels (Get_Sequential_Statement_Chain (Body_Parent));
      Sem_Declaration_Chain (Body_Parent);
      Sem_Specification_Chain (Body_Parent, Null_Iir);

      -- Sem statements.
      Sem_Sequential_Statements_Internal
        (Get_Sequential_Statement_Chain (Body_Parent));

      Check_Full_Declaration (Body_Parent, Body_Parent);

      Current_Subprogram := Outer_Subprogram;
   end Sem_Sequential_Statements;

   --  Sem the instantiated unit of STMT and return the node constaining
   --  ports and generics (either a entity_declaration or a component
   --  declaration).
   function Sem_Instantiated_Unit
     (Stmt : Iir_Component_Instantiation_Statement) return Iir
   is
      Inst : constant Iir := Get_Instantiated_Unit (Stmt);
      Comp_Name : Iir;
      Comp : Iir;
   begin
      if Get_Kind (Inst) in Iir_Kinds_Entity_Aspect then
         return Sem_Entity_Aspect (Inst);
      else
         Comp := Get_Named_Entity (Inst);
         if Comp /= Null_Iir then
            --  Already analyzed before, while trying to separate
            --  concurrent procedure calls from instantiation stmts.
            pragma Assert (Get_Kind (Comp) = Iir_Kind_Component_Declaration);
            return Comp;
         end if;

         --  Needs a denoting name
         if Get_Kind (Inst) not in Iir_Kinds_Denoting_Name then
            Error_Msg_Sem (+Inst, "name for a component expected");
            return Null_Iir;
         end if;

         --  The component may be an entity or a configuration.
         Comp_Name := Sem_Denoting_Name (Inst);
         Set_Instantiated_Unit (Stmt, Comp_Name);
         Comp := Get_Named_Entity (Comp_Name);
         if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
            Error_Class_Match (Comp_Name, "component");
            return Null_Iir;
         end if;

         return Comp;
      end if;
   end Sem_Instantiated_Unit;

   procedure Sem_Component_Instantiation_Statement
     (Stmt: Iir_Component_Instantiation_Statement; Is_Passive : Boolean)
   is
      Decl : Iir;
      Entity_Unit : Iir_Design_Unit;
      Bind : Iir_Binding_Indication;
   begin
      --  FIXME: move this check in parse ?
      if Is_Passive then
         Error_Msg_Sem (+Stmt, "component instantiation forbidden in entity");
      end if;

      --  Check for label.
      --  This cannot be moved in parse since a procedure_call may be revert
      --  into a component instantiation.
      if Get_Label (Stmt) = Null_Identifier then
         Error_Msg_Sem (+Stmt, "component instantiation requires a label");
      end if;

      --  Look for the component.
      Decl := Sem_Instantiated_Unit (Stmt);
      if Decl = Null_Iir then
         return;
      end if;

      --  The association
      Sem_Generic_Port_Association_Chain (Decl, Stmt);

      --  FIXME: add sources for signals, in order to detect multiple sources
      --  to unresolved signals.
      --  What happen if the component is not bound ?

      --  Create a default binding indication if necessary.
      if Get_Component_Configuration (Stmt) = Null_Iir
        and then Is_Component_Instantiation (Stmt)
      then
         Entity_Unit := Get_Visible_Entity_Declaration (Decl);
         if Entity_Unit = Null_Iir then
            if Is_Warning_Enabled (Warnid_Default_Binding)
              and then not Flags.Flag_Elaborate
            then
               Warning_Msg_Sem
                 (Warnid_Default_Binding, +Stmt,
                  "no default binding for instantiation of %n", +Decl);
               Explain_No_Visible_Entity (Decl);
            end if;
         elsif Flags.Flag_Elaborate
           and then (Flags.Flag_Elaborate_With_Outdated
                     or else Get_Date (Entity_Unit) in Date_Valid)
         then
            Bind := Sem_Create_Default_Binding_Indication
              (Decl, Entity_Unit, Stmt, False, True);
            Set_Default_Binding_Indication (Stmt, Bind);
         end if;
      end if;
   end Sem_Component_Instantiation_Statement;

   --  Note: a statement such as
   --    label1: name;
   --  can be parsed as a procedure call statement or as a
   --  component instantiation statement.
   --  Check now and revert in case of error.
   function Sem_Concurrent_Procedure_Call_Statement
     (Stmt : Iir; Is_Passive : Boolean) return Iir
   is
      Call : Iir_Procedure_Call;
      Decl : Iir;
      Label : Name_Id;
      N_Stmt : Iir_Component_Instantiation_Statement;
      Imp : Iir;
   begin
      Call := Get_Procedure_Call (Stmt);
      if Get_Parameter_Association_Chain (Call) = Null_Iir then
         Imp := Get_Prefix (Call);
         Sem_Name (Imp);
         Set_Prefix (Call, Imp);

         Decl := Get_Named_Entity (Imp);
         if Get_Kind (Decl) = Iir_Kind_Component_Declaration then
            N_Stmt := Create_Iir (Iir_Kind_Component_Instantiation_Statement);
            Label := Get_Label (Stmt);
            Set_Label (N_Stmt, Label);
            Set_Parent (N_Stmt, Get_Parent (Stmt));
            Set_Chain (N_Stmt, Get_Chain (Stmt));
            Set_Instantiated_Unit (N_Stmt, Finish_Sem_Name (Imp));
            Location_Copy (N_Stmt, Stmt);

            if Label /= Null_Identifier then
               --  A component instantiation statement must have
               --  a label, this condition is checked during the
               --  sem of the statement.
               Sem_Scopes.Replace_Name (Label, Stmt, N_Stmt);
            end if;

            Free_Iir (Stmt);
            Free_Iir (Call);

            Sem_Component_Instantiation_Statement (N_Stmt, Is_Passive);
            return N_Stmt;
         end if;
      end if;
      Sem_Procedure_Call (Call, Stmt);

      if Is_Passive then
         Imp := Get_Implementation (Call);
         if Imp /= Null_Iir
           and then Get_Kind (Imp) = Iir_Kind_Procedure_Declaration
         then
            Decl := Get_Interface_Declaration_Chain (Imp);
            while Decl /= Null_Iir loop
               if Get_Mode (Decl) in Iir_Out_Modes then
                  Error_Msg_Sem (+Stmt, "%n is not passive", +Imp);
                  exit;
               end if;
               Decl := Get_Chain (Decl);
            end loop;
         end if;
      end if;

      return Stmt;
   end Sem_Concurrent_Procedure_Call_Statement;

   procedure Sem_Block_Statement (Stmt: Iir_Block_Statement)
   is
      Header : constant Iir_Block_Header := Get_Block_Header (Stmt);
      Guard : constant Iir_Guard_Signal_Declaration := Get_Guard_Decl (Stmt);
      Expr: Iir;
      Generic_Chain : Iir;
      Port_Chain : Iir;
   begin
      --  LRM 10.1 Declarative region.
      --  7. A block statement.
      Open_Declarative_Region;

      Set_Is_Within_Flag (Stmt, True);

      if Header /= Null_Iir then
         Generic_Chain := Get_Generic_Chain (Header);
         Sem_Interface_Chain (Generic_Chain, Generic_Interface_List);
         Port_Chain := Get_Port_Chain (Header);
         Sem_Interface_Chain (Port_Chain, Port_Interface_List);

         --  LRM 9.1
         --  Such actuals are evaluated in the context of the enclosing
         --  declarative region.
         --  GHDL: close the declarative region...
         Set_Is_Within_Flag (Stmt, False);
         Close_Declarative_Region;

         Sem_Generic_Port_Association_Chain (Header, Header);

         --  ... and reopen-it.
         Open_Declarative_Region;
         Set_Is_Within_Flag (Stmt, True);
         Add_Declarations_From_Interface_Chain (Generic_Chain);
         Add_Declarations_From_Interface_Chain (Port_Chain);
      end if;

      --  LRM93 9.1
      --  If a guard expression appears after the reserved word BLOCK, then a
      --  signal with the simple name GUARD of predefined type BOOLEAN is
      --  implicitly declared at the beginning of the declarative part of the
      --  block, and the guard expression defined the value of that signal at
      --  any given time.
      if Guard /= Null_Iir then
         --  LRM93 9.1
         --  The type of the guard expression must be type BOOLEAN.
         --  GHDL: guard expression must be analyzed before creating the
         --   implicit GUARD signal, since the expression may reference GUARD.
         Set_Expr_Staticness (Guard, None);
         Set_Name_Staticness (Guard, Locally);
         Expr := Get_Guard_Expression (Guard);
         Expr := Sem_Condition (Expr);
         if Expr /= Null_Iir then
            Set_Guard_Expression (Guard, Expr);
         end if;

         --  FIXME: should extract sensivity now and set the has_active flag
         --  on signals, since the guard expression is evaluated when one of
         --  its signal is active.  However, how can a bug be introduced by
         --  evaluating only when signals have events ?

         --  the guard expression is an implicit definition of a signal named
         --  GUARD.  Create this definition.  This is necessary for the type.
         Set_Identifier (Guard, Std_Names.Name_Guard);
         Set_Type (Guard, Boolean_Type_Definition);
         Set_Block_Statement (Guard, Stmt);
         Sem_Scopes.Add_Name (Guard);
         Set_Visible_Flag (Guard, True);
      end if;

      Sem_Block (Stmt);
      Set_Is_Within_Flag (Stmt, False);
      Close_Declarative_Region;
   end Sem_Block_Statement;

   procedure Sem_Generate_Statement_Body (Bod : Iir) is
   begin
      Set_Is_Within_Flag (Bod, True);
      Sem_Block (Bod);
      Set_Is_Within_Flag (Bod, False);
   end Sem_Generate_Statement_Body;

   procedure Sem_For_Generate_Statement (Stmt : Iir)
   is
      Param : constant Iir := Get_Parameter_Specification (Stmt);
   begin
      --  LRM93 10.1 Declarative region.
      --  12. A generate statement.
      Open_Declarative_Region;
      Set_Is_Within_Flag (Stmt, True);

      Sem_Scopes.Add_Name (Param);

      --  LRM93 7.4.2 (Globally Static Primaries)
      --   4. a generate parameter;
      Sem_Iterator (Param, Globally);
      Set_Visible_Flag (Param, True);

      --  LRM93 9.7
      --  The discrete range in a generation scheme of the first form must
      --  be a static discrete range;
      if not Is_Error (Get_Type (Param))
        and then Get_Type_Staticness (Get_Type (Param)) < Globally
      then
         Error_Msg_Sem (+Stmt, "range must be a static discrete range");
      end if;

      --  In the same declarative region.
      Sem_Generate_Statement_Body (Get_Generate_Statement_Body (Stmt));

      Set_Is_Within_Flag (Stmt, True);
      Close_Declarative_Region;
   end Sem_For_Generate_Statement;

   procedure Sem_If_Case_Generate_Statement_Body (Bod : Iir)
   is
      Alt_Label : Name_Id;
   begin
      Alt_Label := Get_Alternative_Label (Bod);
      --  LRM08 11.8 Generate statements
      --  The alternative labels, if any, within an if generate statement or
      --  a case generate statement shall all be distinct.
      if Alt_Label /= Null_Identifier then
         --  Declare label.  This doesn't appear in the LRM (bug ?), but
         --  used here to detect duplicated labels.
         Sem_Scopes.Add_Name (Bod);
         Xref_Decl (Bod);
      end if;

      --  Contrary to the LRM, a new declarative region is declared.  This
      --  is required so that declarations in a generate statement body are
      --  not in the scope of the following generate bodies.
      Open_Declarative_Region;
      Sem_Generate_Statement_Body (Bod);
      Close_Declarative_Region;
   end Sem_If_Case_Generate_Statement_Body;

   procedure Sem_If_Generate_Statement (Stmt : Iir)
   is
      Clause : Iir;
      Condition : Iir;
   begin
      --  LRM93 10.1 Declarative region.
      --  12. A generate statement.
      Open_Declarative_Region;
      Set_Is_Within_Flag (Stmt, True);

      Clause := Stmt;
      while Clause /= Null_Iir loop
         Condition := Get_Condition (Clause);

         if Condition /= Null_Iir then
            Condition := Sem_Condition (Condition);
            --  LRM93 9.7
            --  the condition in a generation scheme of the second form must be
            --  a static expression.
            if Condition /= Null_Iir
              and then Get_Expr_Staticness (Condition) < Globally
            then
               Error_Msg_Sem
                 (+Condition, "condition must be a static expression");
            else
               Set_Condition (Clause, Condition);
            end if;
         else
            --  No condition for the last 'else' part.
            pragma Assert (Get_Generate_Else_Clause (Clause) = Null_Iir);
            null;
         end if;

         Sem_If_Case_Generate_Statement_Body
           (Get_Generate_Statement_Body (Clause));

         Clause := Get_Generate_Else_Clause (Clause);
      end loop;

      Set_Is_Within_Flag (Stmt, False);
      Close_Declarative_Region;
   end Sem_If_Generate_Statement;

   procedure Sem_Case_Generate_Statement (Stmt : Iir)
   is
      Expr : Iir;
      Chain : Iir;
      El : Iir;
   begin
      --  LRM93 10.1 Declarative region.
      --  12. A generate statement.
      Open_Declarative_Region;
      Set_Is_Within_Flag (Stmt, True);

      Expr := Get_Expression (Stmt);
      Chain := Get_Case_Statement_Alternative_Chain (Stmt);
      -- FIXME: overload.
      Expr := Sem_Case_Expression (Expr);
      if Expr /= Null_Iir then
         Check_Read (Expr);
         Set_Expression (Stmt, Expr);

         if Get_Expr_Staticness (Expr) < Globally then
            Error_Msg_Sem
              (+Expr, "case expression must be a static expression");
         end if;

         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
         Set_Case_Statement_Alternative_Chain (Stmt, Chain);
      end if;

      El := Chain;
      while El /= Null_Iir loop
         if not Get_Same_Alternative_Flag (El) then
            Sem_If_Case_Generate_Statement_Body (Get_Associated_Block (El));
         end if;
         El := Get_Chain (El);
      end loop;

      Set_Is_Within_Flag (Stmt, False);
      Close_Declarative_Region;
   end Sem_Case_Generate_Statement;

   procedure Sem_Process_Statement (Proc: Iir) is
   begin
      Set_Is_Within_Flag (Proc, True);

      --  LRM 10.1
      --  8. A process statement
      Open_Declarative_Region;

      -- Sem declarations
      Sem_Sequential_Statements (Proc, Proc);

      Close_Declarative_Region;

      Set_Is_Within_Flag (Proc, False);

      if Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement
        and then Get_Callees_List (Proc) /= Null_Iir_List
      then
         --  Check there is no wait statement in subprograms called.
         --  Also in the case of all-sensitized process, check that package
         --  subprograms don't read signals.
         Sem.Add_Analysis_Checks_List (Proc);
      end if;
   end Sem_Process_Statement;

   procedure Sem_Sensitized_Process_Statement
     (Proc: Iir_Sensitized_Process_Statement) is
   begin
      Sem_Sensitivity_List (Get_Sensitivity_List (Proc));
      Sem_Process_Statement (Proc);
   end Sem_Sensitized_Process_Statement;

   procedure Sem_Concurrent_Selected_Signal_Assignment (Stmt: Iir)
   is
      Expr: Iir;
      Chain : Iir;
   begin
      --  LRM 9.5  Concurrent Signal Assgnment Statements.
      --  The process statement equivalent to a concurrent signal assignment
      --  statement [...] is constructed as follows: [...]
      --
      --  LRM 9.5.2  Selected Signal Assignment
      --  The characteristics of the selected expression, the waveforms and
      --  the choices in the selected assignment statement must be such that
      --  the case statement in the equivalent statement is a legal
      --  statement

      --  Target and waveforms.
      Sem_Signal_Assignment (Stmt);

      --  The choices.
      Chain := Get_Selected_Waveform_Chain (Stmt);
      Expr := Sem_Case_Expression (Get_Expression (Stmt));
      if Expr /= Null_Iir then
         Check_Read (Expr);
         Set_Expression (Stmt, Expr);
         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
         Set_Selected_Waveform_Chain (Stmt, Chain);
      end if;

      Sem_Guard (Stmt);
   end Sem_Concurrent_Selected_Signal_Assignment;

   procedure Sem_Concurrent_Break_Statement (Stmt : Iir)
   is
      Sensitivity_List : Iir_List;
   begin
      Sem_Break_List (Get_Break_Element (Stmt));

      Sensitivity_List := Get_Sensitivity_List (Stmt);
      if Sensitivity_List /= Null_Iir_List then
         Sem_Sensitivity_List (Sensitivity_List);
      end if;

      Sem_Condition_Opt (Stmt);
   end Sem_Concurrent_Break_Statement;

   procedure Sem_Simple_Simultaneous_Statement (Stmt : Iir)
   is
      Left, Right : Iir;
      Left_Type, Right_Type : Iir;
      Res_Type : Iir;
   begin
      Left := Get_Simultaneous_Left (Stmt);
      Right := Get_Simultaneous_Right (Stmt);

      Left := Sem_Expression_Ov (Left, Null_Iir);
      Right := Sem_Expression_Ov (Right, Null_Iir);

      --  Give up in case of error
      if Left = Null_Iir or else Right = Null_Iir then
         return;
      end if;

      Left_Type := Get_Type (Left);
      Right_Type := Get_Type (Right);
      if Left_Type = Null_Iir or else Right_Type = Null_Iir then
         return;
      end if;

      Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right));
      if Res_Type = Null_Iir then
         Error_Msg_Sem
           (+Stmt, "types of left and right expressions are incompatible");
         return;
      end if;

      --  AMS-LRM17 11.10 Simple simultaneous statement
      --  The base type of each simple expression shall be the same nature
      --  type.
      if not Sem_Types.Is_Nature_Type (Res_Type) then
         Error_Msg_Sem (+Stmt, "type of expressions must be a float types");
      end if;

      if not Is_Expr_Fully_Analyzed (Left) then
         Left := Sem_Expression_Ov (Left, Res_Type);
      end if;
      if not Is_Expr_Fully_Analyzed (Right) then
         Right := Sem_Expression_Ov (Right, Res_Type);
      end if;

      Set_Simultaneous_Left (Stmt, Left);
      Set_Simultaneous_Right (Stmt, Right);

      --  FIXME: check for nature type...
   end Sem_Simple_Simultaneous_Statement;

   procedure Sem_Simultaneous_If_Statement (Stmt : Iir)
   is
      Clause : Iir;
   begin
      Clause := Stmt;
      while Clause /= Null_Iir loop
         Sem_Condition_Opt (Clause);
         Sem_Simultaneous_Statements
           (Get_Simultaneous_Statement_Chain (Clause));
         Clause := Get_Else_Clause (Clause);
      end loop;
   end Sem_Simultaneous_If_Statement;

   procedure Sem_Simultaneous_Case_Statement (Stmt : Iir)
   is
      Expr: Iir;
      Chain : Iir;
      El: Iir;
   begin
      Expr := Get_Expression (Stmt);
      Expr := Sem_Case_Expression (Expr);
      if Expr /= Null_Iir then
         Check_Read (Expr);
         Set_Expression (Stmt, Expr);

         Chain := Get_Case_Statement_Alternative_Chain (Stmt);
         Sem_Case_Choices (Expr, Chain, Get_Location (Stmt));
         Set_Case_Statement_Alternative_Chain (Stmt, Chain);
      end if;

      El := Chain;
      while El /= Null_Iir loop
         if not Get_Same_Alternative_Flag (El) then
            Sem_Simultaneous_Statements (Get_Associated_Chain (El));
         end if;
         El := Get_Chain (El);
      end loop;
   end Sem_Simultaneous_Case_Statement;

   procedure Sem_Simultaneous_Procedural_Statement (Stmt : Iir) is
   begin
      Set_Is_Within_Flag (Stmt, True);

      --  AMS-LRM17 12.1 Declarative region
      --  j) A simultaneous procedural statement
      Open_Declarative_Region;

      Sem_Sequential_Statements (Stmt, Stmt);

      Close_Declarative_Region;

      Set_Is_Within_Flag (Stmt, False);
   end Sem_Simultaneous_Procedural_Statement;

   procedure Sem_Simultaneous_Statements (First : Iir)
   is
      Stmt : Iir;
   begin
      Stmt := First;
      while Stmt /= Null_Iir loop
         case Get_Kind (Stmt) is
            when Iir_Kind_Simple_Simultaneous_Statement =>
               Sem_Simple_Simultaneous_Statement (Stmt);
            when Iir_Kind_Simultaneous_If_Statement =>
               Sem_Simultaneous_If_Statement (Stmt);
            when Iir_Kind_Simultaneous_Case_Statement =>
               Sem_Simultaneous_Case_Statement (Stmt);
            when Iir_Kind_Simultaneous_Procedural_Statement =>
               Sem_Simultaneous_Procedural_Statement (Stmt);
            when Iir_Kind_Simultaneous_Null_Statement =>
               null;
            when others =>
               Error_Kind ("sem_simultaneous_statements", Stmt);
         end case;
         Stmt := Get_Chain (Stmt);
      end loop;
   end Sem_Simultaneous_Statements;

   procedure Sem_Concurrent_Statement (Stmt : in out Iir; Is_Passive : Boolean)
   is
      Prev_Concurrent_Statement : constant Iir := Current_Concurrent_Statement;

      procedure No_Generate_Statement is
      begin
         if Is_Passive then
            Error_Msg_Sem (+Stmt, "generate statement forbidden in entity");
         end if;
      end No_Generate_Statement;
   begin
      Current_Concurrent_Statement := Stmt;

      case Get_Kind (Stmt) is
         when Iir_Kind_Concurrent_Simple_Signal_Assignment
           | Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
            if Is_Passive then
               Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity");
            end if;
            Sem_Signal_Assignment (Stmt);
         when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
            if Is_Passive then
               Error_Msg_Sem (+Stmt, "signal assignment forbidden in entity");
            end if;
            Sem_Concurrent_Selected_Signal_Assignment (Stmt);
         when Iir_Kind_Sensitized_Process_Statement =>
            Set_Passive_Flag (Stmt, Is_Passive);
            Sem_Sensitized_Process_Statement (Stmt);
         when Iir_Kind_Process_Statement =>
            Set_Passive_Flag (Stmt, Is_Passive);
            Sem_Process_Statement (Stmt);
         when Iir_Kind_Component_Instantiation_Statement =>
            Sem_Component_Instantiation_Statement (Stmt, Is_Passive);
         when Iir_Kind_Concurrent_Assertion_Statement =>
            --  FIXME: must check assertion expressions does not contain
            --  non-passive subprograms ??
            Sem_Assertion_Statement (Stmt);
         when Iir_Kind_Block_Statement =>
            if Is_Passive then
               Error_Msg_Sem (+Stmt, "block forbidden in entity");
            end if;
            Sem_Block_Statement (Stmt);
         when Iir_Kind_If_Generate_Statement =>
            No_Generate_Statement;
            Sem_If_Generate_Statement (Stmt);
         when Iir_Kind_For_Generate_Statement =>
            No_Generate_Statement;
            Sem_For_Generate_Statement (Stmt);
         when Iir_Kind_Case_Generate_Statement =>
            No_Generate_Statement;
            Sem_Case_Generate_Statement (Stmt);
         when Iir_Kind_Concurrent_Procedure_Call_Statement =>
            Stmt :=
              Sem_Concurrent_Procedure_Call_Statement (Stmt, Is_Passive);
         when Iir_Kind_Concurrent_Break_Statement =>
            Sem_Concurrent_Break_Statement (Stmt);
         when Iir_Kind_Psl_Declaration =>
            Sem_Psl.Sem_Psl_Declaration (Stmt);
         when Iir_Kind_Psl_Endpoint_Declaration =>
            Sem_Psl.Sem_Psl_Endpoint_Declaration (Stmt);
         when Iir_Kind_Psl_Assert_Directive =>
            Stmt := Sem_Psl.Sem_Psl_Assert_Directive (Stmt, True);
         when Iir_Kind_Psl_Assume_Directive =>
            Sem_Psl.Sem_Psl_Assume_Directive (Stmt);
         when Iir_Kind_Psl_Cover_Directive =>
            Sem_Psl.Sem_Psl_Cover_Directive (Stmt);
         when Iir_Kind_Psl_Restrict_Directive =>
            Sem_Psl.Sem_Psl_Restrict_Directive (Stmt);
         when Iir_Kind_Psl_Default_Clock =>
            Sem_Psl.Sem_Psl_Default_Clock (Stmt);
         when Iir_Kind_Simple_Simultaneous_Statement =>
            Sem_Simple_Simultaneous_Statement (Stmt);
         when Iir_Kind_Simultaneous_If_Statement =>
            Sem_Simultaneous_If_Statement (Stmt);
         when Iir_Kind_Simultaneous_Case_Statement =>
            Sem_Simultaneous_Case_Statement (Stmt);
         when Iir_Kind_Simultaneous_Procedural_Statement =>
            Sem_Simultaneous_Procedural_Statement (Stmt);
         when Iir_Kind_Simultaneous_Null_Statement =>
            null;
         when others =>
            Error_Kind ("sem_concurrent_statement", Stmt);
      end case;

      Current_Concurrent_Statement := Prev_Concurrent_Statement;
   end Sem_Concurrent_Statement;

   procedure Sem_Concurrent_Statement_Chain (Parent : Iir)
   is
      Is_Passive : constant Boolean :=
        Get_Kind (Parent) = Iir_Kind_Entity_Declaration;

      Stmt : Iir;
      Prev_Stmt : Iir;
   begin
      Stmt := Get_Concurrent_Statement_Chain (Parent);
      Prev_Stmt := Null_Iir;
      while Stmt /= Null_Iir loop
         Sem_Concurrent_Statement (Stmt, Is_Passive);

         pragma Assert (Get_Parent (Stmt) = Parent);

         --  Replace this node.
         if Prev_Stmt = Null_Iir then
            Set_Concurrent_Statement_Chain (Parent, Stmt);
         else
            Set_Chain (Prev_Stmt, Stmt);
         end if;
         Prev_Stmt := Stmt;
         Stmt := Get_Chain (Stmt);
      end loop;
   end Sem_Concurrent_Statement_Chain;

   --  Put labels in declarative region.
   procedure Sem_Labels_Chain (Parent : Iir)
   is
      Stmt: Iir;
      Label: Name_Id;
   begin
      Stmt := Get_Concurrent_Statement_Chain (Parent);
      while Stmt /= Null_Iir loop

         case Get_Kind (Stmt) is
            when Iir_Kind_Psl_Declaration
              | Iir_Kind_Psl_Endpoint_Declaration =>
               --  Special case for in-lined PSL declarations.
               null;
            when others =>
               Label := Get_Label (Stmt);

               if Label /= Null_Identifier then
                  Sem_Scopes.Add_Name (Stmt);
                  Name_Visible (Stmt);
                  Xref_Decl (Stmt);
               end if;
         end case;

         --  INT-1991/issue report 27
         --  Generate statements represent declarative region and have
         --  implicit declarative part.
         if False
           and then Flags.Vhdl_Std = Vhdl_87
           and then
           (Get_Kind (Stmt) = Iir_Kind_For_Generate_Statement
              or else Get_Kind (Stmt) = Iir_Kind_If_Generate_Statement)
         then
            Sem_Labels_Chain (Stmt);
         end if;

         Stmt := Get_Chain (Stmt);
      end loop;
   end Sem_Labels_Chain;

   procedure Sem_Block (Blk: Iir)
   is
      Implicit : Implicit_Signal_Declaration_Type;
      Prev_Psl_Default_Clock : Iir;
   begin
      Prev_Psl_Default_Clock := Current_Psl_Default_Clock;
      Push_Signals_Declarative_Part (Implicit, Blk);

      Sem_Labels_Chain (Blk);
      Sem_Declaration_Chain (Blk);

      Sem_Concurrent_Statement_Chain (Blk);

      --  FIXME: do it only if there is conf. spec. in the declarative
      --  part.
      Sem_Specification_Chain (Blk, Blk);
      Check_Full_Declaration (Blk, Blk);

      Pop_Signals_Declarative_Part (Implicit);
      Current_Psl_Default_Clock := Prev_Psl_Default_Clock;
   end Sem_Block;

   --  Add a driver for SIG.
   --  STMT is used in case of error (it is the statement that creates the
   --   driver).
   --  Do nothing if:
   --    The current statement list does not belong to a process,
   --    SIG is a formal signal interface.
   procedure Sem_Add_Driver (Sig : Iir; Stmt : Iir)
   is
      Sig_Object : Iir;
      Sig_Object_Type : Iir;
   begin
      if Sig = Null_Iir then
         return;
      end if;
      Sig_Object := Get_Object_Prefix (Sig);
      Sig_Object_Type := Get_Type (Sig_Object);

      --  LRM 4.3.1.2 Signal Declaration
      --  It is an error if, after the elaboration of a description, a
      --  signal has multiple sources and it is not a resolved signal.

      --  Check for multiple driver for a unresolved signal declaration.
      --  Do this only if the object is a non-composite signal declaration.
      --  NOTE: THIS IS DISABLED, since the assignment may be within a
      --  generate statement.
      if False
        and then Get_Kind (Sig_Object) = Iir_Kind_Signal_Declaration
        and then Get_Kind (Sig_Object_Type)
        not in Iir_Kinds_Composite_Type_Definition
        and then not Get_Resolved_Flag (Sig_Object_Type)
      then
         if Get_Signal_Driver (Sig_Object) /= Null_Iir and then
           Get_Signal_Driver (Sig_Object) /= Current_Concurrent_Statement
         then
            Error_Msg_Sem (+Stmt, "unresolved %n has already a driver at %l",
                           (+Sig_Object, +Get_Signal_Driver (Sig_Object)));
         else
            Set_Signal_Driver (Sig_Object, Current_Concurrent_Statement);
         end if;
      end if;

      --  LRM 8.4.1
      --  If a given procedure is declared by a declarative item that is not
      --  contained within a process statement, and if a signal assignment
      --  statement appears in that procedure, then the target of the
      --  assignment statement must be a formal parameter of the given
      --  procedure or of a parent of that procedure, or an aggregate of such
      --  formal parameters.
      --  Similarly, if a given procedure is declared by a declarative item
      --  that is not contained within a process statement and if a signal is
      --  associated with an INOUT or OUT mode signal parameter in a
      --  subprogram call within that procedure, then the signal so associated
      --  must be a formal parameter of the given procedure or of a parent of
      --  that procedure.
      if Current_Concurrent_Statement = Null_Iir
        or else (Get_Kind (Current_Concurrent_Statement)
                 not in Iir_Kinds_Process_Statement)
      then
         --  Not within a process statement.
         if Current_Subprogram = Null_Iir then
            --  not within a subprogram: concurrent statement.
            return;
         end if;

         --  Within a subprogram.
         if Get_Kind (Sig_Object) = Iir_Kind_Signal_Declaration
           or else not Is_Parameter (Sig_Object)
         then
            Error_Msg_Sem (+Stmt, "%n is not a formal parameter", +Sig_Object);
         end if;
      end if;
   end Sem_Add_Driver;
end Vhdl.Sem_Stmts;