vhdl08: add oread, hread.

9 files changed, 284 insertions, 31 deletions

diff --git a/evaluation.adb b/evaluation.adb
index 9f0bae4e4..61ec39f12 100644
--- a/evaluation.adb
+++ b/evaluation.adb
@@ -1221,7 +1221,9 @@ package body Evaluation is
            | Iir_Predefined_Attribute_Last_Active
            | Iir_Predefined_Attribute_Driving
            | Iir_Predefined_Attribute_Driving_Value
-           | Iir_Predefined_Array_To_String =>
+           | Iir_Predefined_Array_To_String
+           | Iir_Predefined_Bit_Vector_To_Ostring
+           | Iir_Predefined_Bit_Vector_To_Hstring =>
             --  Not binary or never locally static.
             Error_Internal (Orig, "eval_dyadic_operator: " &
                               Iir_Predefined_Functions'Image (Func));
diff --git a/iirs.ads b/iirs.ads
index 1406c6bd7..ca7202331 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -3324,6 +3324,8 @@ package Iirs is
 
    --  To_String
        Iir_Predefined_Array_To_String,
+       Iir_Predefined_Bit_Vector_To_Ostring,
+       Iir_Predefined_Bit_Vector_To_Hstring,
 
    --  IEEE.Std_Logic_1164.Std_Ulogic
        Iir_Predefined_Std_Ulogic_Match_Equality,
diff --git a/libraries/std/textio.vhdl b/libraries/std/textio.vhdl
index b9d1e4771..49e404325 100644
--- a/libraries/std/textio.vhdl
+++ b/libraries/std/textio.vhdl
@@ -103,6 +103,18 @@ package Textio is
   alias BREAD is READ [LINE, BIT_VECTOR];
   alias BINARY_READ is READ [LINE, BIT_VECTOR, BOOLEAN];
   alias BINARY_READ is READ [LINE, BIT_VECTOR];
+
+  procedure Oread (L : inout Line; Value : out Bit_Vector; Good : out Boolean);
+  procedure Oread (L : inout Line; Value : out Bit_Vector);
+
+  alias OCTAL_READ is OREAD [LINE, BIT_VECTOR, BOOLEAN];
+  alias OCTAL_READ is OREAD [LINE, BIT_VECTOR];
+
+  procedure Hread (L : inout Line; Value : out Bit_Vector; Good : out Boolean);
+  procedure Hread (L : inout Line; Value : out Bit_Vector);
+
+  alias HEX_READ is HREAD [LINE, BIT_VECTOR, BOOLEAN];
+  alias HEX_READ is HREAD [LINE, BIT_VECTOR];
   --END-V08
 
 -- output routines for standard types
diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl
index 847a17ef8..a57ed03c3 100644
--- a/libraries/std/textio_body.vhdl
+++ b/libraries/std/textio_body.vhdl
@@ -1426,5 +1426,225 @@ package body textio is
     deallocate (l);
     l := nl;
   end sread;
+
+  subtype bv4 is bit_vector (1 to 4);
+
+  function char_to_bv4 (c : character) return bv4 is
+  begin
+    case c is
+      when '0' => return "0000";
+      when '1' => return "0001";
+      when '2' => return "0010";
+      when '3' => return "0011";
+      when '4' => return "0100";
+      when '5' => return "0101";
+      when '6' => return "0110";
+      when '7' => return "0111";
+      when '8' => return "1000";
+      when '9' => return "1001";
+      when 'a' | 'A' => return "1010";
+      when 'b' | 'B' => return "1011";
+      when 'c' | 'C' => return "1100";
+      when 'd' | 'D' => return "1101";
+      when 'e' | 'E' => return "1110";
+      when 'f' | 'F' => return "1111";
+      when others =>
+        assert false report "bad hexa digit" severity failure;
+    end case;
+  end char_to_bv4;
+
+  procedure Oread (L : inout Line; Value : out Bit_Vector; Good : out Boolean)
+  is
+    --  Length of Value
+    constant vlen : natural := value'length;
+
+    --  Number of octal digits for Value
+    constant olen : natural := (vlen + 2) / 3;
+
+    variable res : bit_vector (1 to olen * 3);
+
+    --  Number of bit to parse.
+    variable len : natural;
+
+    variable pos : natural;
+
+    --  Last character from LEN to be removed
+    variable last : integer;
+
+    --  State of the previous byte:
+    --  SKIP: blank before the bit vector.
+    --  DIGIT: previous character was a digit
+    --  UNDERSCORE: was '_'
+    type state_type is (skip, digit, underscore);
+    variable state : state_type;
+  begin
+    --  Initialization.
+    if vlen = 0 then
+      --  If VALUE is a nul array, return now.
+      --  L stay unchanged.
+      --  FIXME: should blanks be removed ?
+      good := true;
+      return;
+    end if;
+    good := false;
+    state := skip;
+    pos := res'left;
+    if l'ascending then
+      last := l'left - 1;
+    else
+      last := l'left + 1;
+    end if;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP
+	  | HT =>
+	  exit when state /= skip;
+        when '_' =>
+          exit when state /= digit;
+          state := underscore;
+        when '0' to '7' =>
+          res (pos to pos + 2) := char_to_bv4 (l (i)) (2 to 4);
+          last := i;
+          state := digit;
+          pos := pos + 3;
+          --  LRM08 16.4
+          --  Character removal and compostion also stops when the expected
+          --  number of digits have been removed.
+          exit when pos = res'right + 1;
+        when others =>
+          exit;
+      end case;
+    end loop;
+
+    --  LRM08 16.4
+    --  The OREAD or HEAD procedure does not succeed if less than the expected
+    --  number of digits are removed.
+    if pos /= res'right + 1 then
+      return;
+    end if;
+
+    --  LRM08 16.4
+    --  The rightmost value'length bits of the binary number are used to form
+    --  the result for the VALUE parameter, [with a '0' element corresponding
+    --  to a 0 bit and a '1' element corresponding to a 1 bit].  The OREAD or
+    --  HREAD procedure does not succeed if any unused bits are 1.
+    for i in 1 to res'right - vlen loop
+      if res (i) = '1' then
+        return;
+      end if;
+    end loop;
+
+    Value := res (res'right - vlen + 1 to res'right);
+    good := true;
+    trim_next (l, last);
+  end Oread;
+
+  procedure Oread (L : inout Line; Value : out Bit_Vector)
+  is
+    variable res : boolean;
+  begin
+    Oread (l, value, res);
+    assert res = true
+      report "octal bit_vector read failure"
+      severity failure;
+  end Oread;
+
+  procedure Hread (L : inout Line; Value : out Bit_Vector; Good : out Boolean)
+  is
+    --  Length of Value
+    constant vlen : natural := value'length;
+
+    --  Number of hexa digits for Value
+    constant hlen : natural := (vlen + 3) / 4;
+
+    variable res : bit_vector (1 to hlen * 4);
+
+    --  Number of bit to parse.
+    variable len : natural;
+
+    variable pos : natural;
+
+    --  Last character from LEN to be removed
+    variable last : integer;
+
+    --  State of the previous byte:
+    --  SKIP: blank before the bit vector.
+    --  DIGIT: previous character was a digit
+    --  UNDERSCORE: was '_'
+    type state_type is (skip, digit, underscore);
+    variable state : state_type;
+  begin
+    --  Initialization.
+    if vlen = 0 then
+      --  If VALUE is a nul array, return now.
+      --  L stay unchanged.
+      --  FIXME: should blanks be removed ?
+      good := true;
+      return;
+    end if;
+    good := false;
+    state := skip;
+    pos := res'left;
+    if l'ascending then
+      last := l'left - 1;
+    else
+      last := l'left + 1;
+    end if;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP
+	  | HT =>
+	  exit when state /= skip;
+        when '_' =>
+          exit when state /= digit;
+          state := underscore;
+        when '0' to '9' | 'a' to 'f' | 'A' to 'F' =>
+          res (pos to pos + 3) := char_to_bv4 (l (i));
+          last := i;
+          state := digit;
+          pos := pos + 4;
+          --  LRM08 16.4
+          --  Character removal and compostion also stops when the expected
+          --  number of digits have been removed.
+          exit when pos = res'right + 1;
+        when others =>
+          exit;
+      end case;
+    end loop;
+
+    --  LRM08 16.4
+    --  The OREAD or HEAD procedure does not succeed if less than the expected
+    --  number of digits are removed.
+    if pos /= res'right + 1 then
+      return;
+    end if;
+
+    --  LRM08 16.4
+    --  The rightmost value'length bits of the binary number are used to form
+    --  the result for the VALUE parameter, [with a '0' element corresponding
+    --  to a 0 bit and a '1' element corresponding to a 1 bit].  The OREAD or
+    --  HREAD procedure does not succeed if any unused bits are 1.
+    for i in 1 to res'right - vlen loop
+      if res (i) = '1' then
+        return;
+      end if;
+    end loop;
+
+    Value := res (res'right - vlen + 1 to res'right);
+    good := true;
+    trim_next (l, last);
+  end Hread;
+
+  procedure Hread (L : inout Line; Value : out Bit_Vector)
+  is
+    variable res : boolean;
+  begin
+    Hread (l, value, res);
+    assert res = true
+      report "hexa bit_vector read failure"
+      severity failure;
+  end Hread;
   --END-V08
 end textio;
diff --git a/sem_decls.adb b/sem_decls.adb
index 1f96fb756..a878cbe8b 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -767,26 +767,6 @@ package body Sem_Decls is
                                  Element_Element_Inter_Chain,
                                  Type_Definition);
 
-                  --  LRM08 5.3.2.4  Predefined operations on array type
-                  --
-                  --  Given a type declaration that declares a one-dimensional
-                  --  array type T whose element type is a character type that
-                  --  contains only character literals, the following operation
-                  --  is implicitely declared immediately following the type
-                  --  declaration
-                  if Vhdl_Std >= Vhdl_08
-                    and then String_Type_Definition /= Null_Iir
-                    and then Get_Kind (Get_Base_Type (Element_Type))
-                    = Iir_Kind_Enumeration_Type_Definition
-                    and then Get_Only_Characters_Flag
-                    (Get_Base_Type (Element_Type))
-                  then
-                     Add_Operation (Name_To_String,
-                                    Iir_Predefined_Array_To_String,
-                                    Unary_Chain,
-                                    String_Type_Definition);
-                  end if;
-
                   --  LRM08 5.3.2.4 Predefined operations on array types
                   --  In addition, given a type declaration that declares a
                   --  one-dimensional array type T whose elements are of a
@@ -939,6 +919,25 @@ package body Sem_Decls is
                            Binary_Chain, Element_Type);
                      end if;
                   end if;
+
+                  --  LRM08 5.3.2.4  Predefined operations on array type
+                  --
+                  --  Given a type declaration that declares a one-dimensional
+                  --  array type T whose element type is a character type that
+                  --  contains only character literals, the following operation
+                  --  is implicitely declared immediately following the type
+                  --  declaration
+                  if Vhdl_Std >= Vhdl_08
+                    and then String_Type_Definition /= Null_Iir
+                    and then (Get_Kind (Element_Type)
+                                = Iir_Kind_Enumeration_Type_Definition)
+                    and then Get_Only_Characters_Flag (Element_Type)
+                  then
+                     Add_Operation (Name_To_String,
+                                    Iir_Predefined_Array_To_String,
+                                    Unary_Chain,
+                                    String_Type_Definition);
+                  end if;
                end if;
             end;
 
diff --git a/sem_expr.adb b/sem_expr.adb
index 26ad5af1a..aac561a90 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -1146,6 +1146,7 @@ package body Sem_Expr is
       end case;
    end Sem_Subprogram_Call_Finish;
 
+   --  EXPR is a function or procedure call.
    function Sem_Subprogram_Call_Stage1
      (Expr : Iir; A_Type : Iir; Is_Func_Call : Boolean)
      return Iir
@@ -1208,8 +1209,9 @@ package body Sem_Expr is
       -- Create a set of possible return type in RES_TYPE.
       case Nbr_Inter is
          when 0 =>
-            Error_Msg_Sem ("can't find a subprogram for this overload call",
-                           Expr);
+            --  FIXME: display subprogram name.
+            Error_Msg_Sem
+              ("cannot resolve overloading for subprogram call", Expr);
             return Null_Iir;
          when 1 =>
             -- Very simple case: no overloading.
diff --git a/sem_names.adb b/sem_names.adb
index bc9b0ed1e..3b34ba5ce 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1837,13 +1837,13 @@ package body Sem_Names is
             return Null_Iir;
          end if;
 
-         --  Only prefixes can be indexed or sliced.
+         --  Only values can be indexed or sliced.
          --  Catch errors such as slice of a type conversion.
          if not Is_Object_Name (Sub_Name)
            and then Get_Kind (Sub_Name) not in Iir_Kinds_Function_Declaration
          then
             if Finish then
-               Error_Msg_Sem ("prefix is not a name (found "
+               Error_Msg_Sem ("prefix is not an array value (found "
                               & Disp_Node (Sub_Name) & ")", Name);
             end if;
             return Null_Iir;
@@ -1854,8 +1854,7 @@ package body Sem_Names is
          if Get_Kind (Base_Type) = Iir_Kind_Access_Type_Definition
          then
             Ptr_Type := Base_Type;
-            Base_Type :=
-              Get_Base_Type (Get_Designated_Type (Base_Type));
+            Base_Type := Get_Base_Type (Get_Designated_Type (Base_Type));
          else
             Ptr_Type := Null_Iir;
          end if;
@@ -1878,8 +1877,7 @@ package body Sem_Names is
 
          if not Maybe_Function_Call (Sub_Name) then
             if Finish then
-               --  Should not happen.
-               raise Internal_Error;
+               Error_Msg_Sem ("missing parameters for function call", Name);
             end if;
             return Null_Iir;
          end if;
diff --git a/simulate/debugger.adb b/simulate/debugger.adb
index 0a65b9105..37419bb1e 100644
--- a/simulate/debugger.adb
+++ b/simulate/debugger.adb
@@ -1237,7 +1237,8 @@ package body Debugger is
            | Iir_Kind_Exit_Statement
            | Iir_Kind_Procedure_Call_Statement
            | Iir_Kind_If_Statement
-           | Iir_Kind_While_Loop_Statement =>
+           | Iir_Kind_While_Loop_Statement
+           | Iir_Kind_Case_Statement =>
             Foreach_Scopes (Get_Parent (N), Handler);
 
          when Iir_Kind_For_Loop_Statement
diff --git a/std_package.adb b/std_package.adb
index 8b6e21beb..4345637df 100644
--- a/std_package.adb
+++ b/std_package.adb
@@ -262,6 +262,7 @@ package body Std_Package is
       --  function TO_STRING (VALUE: inter_type) return STRING;
       procedure Create_To_String (Inter_Type : Iir;
                                   Imp : Iir_Predefined_Functions;
+                                  Name : Name_Id := Std_Names.Name_To_String;
                                   Inter2_Id : Name_Id := Null_Identifier;
                                   Inter2_Type : Iir := Null_Iir)
       is
@@ -270,7 +271,7 @@ package body Std_Package is
          Inter2 : Iir_Constant_Interface_Declaration;
       begin
          Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration);
-         Set_Std_Identifier (Decl, Std_Names.Name_To_String);
+         Set_Std_Identifier (Decl, Name);
          Set_Return_Type (Decl, String_Type_Definition);
          Set_Pure_Flag (Decl, True);
          Set_Implicit_Definition (Decl, Imp);
@@ -968,6 +969,19 @@ package body Std_Package is
       Create_Array_Type (Bit_Vector_Type_Definition, Bit_Vector_Type,
                          Bit_Type_Definition, Name_Bit_Vector);
 
+      --  LRM08 5.3.2.4 Predefined operations on array types
+      --  The following operations are implicitly declared in package
+      --  STD.STANDARD immediately following the declaration of type
+      --  BIT_VECTOR:
+      if Vhdl_Std >= Vhdl_08 then
+         Create_To_String (Bit_Vector_Type_Definition,
+                           Iir_Predefined_Bit_Vector_To_Ostring,
+                           Name_To_Ostring);
+         Create_To_String (Bit_Vector_Type_Definition,
+                           Iir_Predefined_Bit_Vector_To_Hstring,
+                           Name_To_Hstring);
+      end if;
+
       --  VHDL 2008
       --  Vector types
       if Vhdl_Std >= Vhdl_08 then
@@ -1107,14 +1121,17 @@ package body Std_Package is
          --  Predefined overload TO_STRING operations
          Create_To_String (Real_Type_Definition,
                            Iir_Predefined_Real_To_String_Digits,
+                           Name_To_String,
                            Name_Digits,
                            Natural_Subtype_Definition);
          Create_To_String (Real_Type_Definition,
                            Iir_Predefined_Real_To_String_Format,
+                           Name_To_String,
                            Name_Format,
                            String_Type_Definition);
          Create_To_String (Time_Type_Definition,
                            Iir_Predefined_Time_To_String_Unit,
+                           Name_To_String,
                            Name_Unit,
                            Time_Subtype_Definition);
       end if;