diff options
| -rw-r--r-- | evaluation.adb | 4 | ||||
| -rw-r--r-- | iirs.ads | 2 | ||||
| -rw-r--r-- | libraries/std/textio.vhdl | 12 | ||||
| -rw-r--r-- | libraries/std/textio_body.vhdl | 220 | ||||
| -rw-r--r-- | sem_decls.adb | 39 | ||||
| -rw-r--r-- | sem_expr.adb | 6 | ||||
| -rw-r--r-- | sem_names.adb | 10 | ||||
| -rw-r--r-- | simulate/debugger.adb | 3 | ||||
| -rw-r--r-- | std_package.adb | 19 |
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)); @@ -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; |