1-- GHDL Run Time (GRT) std_logic_1664 subprograms. 2-- Copyright (C) 2014 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16-- 17-- As a special exception, if other files instantiate generics from this 18-- unit, or you link this unit with other files to produce an executable, 19-- this unit does not by itself cause the resulting executable to be 20-- covered by the GNU General Public License. This exception does not 21-- however invalidate any other reasons why the executable file might be 22-- covered by the GNU Public License. 23 24with Grt.Lib; 25with Grt.Errors; use Grt.Errors; 26with Grt.Severity; use Grt.Severity; 27 28package body Grt.Std_Logic_1164 is 29 Assert_DC_Msg : constant String := 30 "STD_LOGIC_1164: '-' operand for matching ordering operator"; 31 32 Assert_DC_Msg_Bound : constant Std_String_Bound := 33 (Dim_1 => (Left => 1, Right => Assert_DC_Msg'Length, Dir => Dir_To, 34 Length => Assert_DC_Msg'Length)); 35 36 Assert_DC_Msg_Str : aliased constant Std_String := 37 (Base => To_Std_String_Basep (Assert_DC_Msg'Address), 38 Bounds => To_Std_String_Boundp (Assert_DC_Msg_Bound'Address)); 39 40 Filename : constant String := "std_logic_1164.vhdl" & NUL; 41 Loc : aliased constant Ghdl_Location := 42 (Filename => To_Ghdl_C_String (Filename'Address), 43 Line => 58, 44 Col => 3); 45 46 procedure Assert_Not_Match 47 is 48 use Grt.Lib; 49 begin 50 Ghdl_Ieee_Assert_Failed 51 (To_Std_String_Ptr (Assert_DC_Msg_Str'Address), Error_Severity, 52 To_Ghdl_Location_Ptr (Loc'Address)); 53 end Assert_Not_Match; 54 55 function Ghdl_Std_Ulogic_Match_Eq (L, R : Ghdl_E8) return Ghdl_E8 56 is 57 Left : constant Std_Ulogic := Std_Ulogic'Val (L); 58 Right : constant Std_Ulogic := Std_Ulogic'Val (R); 59 begin 60 return Std_Ulogic'Pos (Match_Eq_Table (Left, Right)); 61 end Ghdl_Std_Ulogic_Match_Eq; 62 63 function Ghdl_Std_Ulogic_Match_Ne (L, R : Ghdl_E8) return Ghdl_E8 64 is 65 Left : constant Std_Ulogic := Std_Ulogic'Val (L); 66 Right : constant Std_Ulogic := Std_Ulogic'Val (R); 67 begin 68 return Std_Ulogic'Pos (Not_Table (Match_Eq_Table (Left, Right))); 69 end Ghdl_Std_Ulogic_Match_Ne; 70 71 function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8 72 is 73 Left : constant Std_Ulogic := Std_Ulogic'Val (L); 74 Right : constant Std_Ulogic := Std_Ulogic'Val (R); 75 begin 76 if Left = '-' or Right = '-' then 77 Assert_Not_Match; 78 end if; 79 return Std_Ulogic'Pos (Match_Lt_Table (Left, Right)); 80 end Ghdl_Std_Ulogic_Match_Lt; 81 82 function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8 83 is 84 Left : constant Std_Ulogic := Std_Ulogic'Val (L); 85 Right : constant Std_Ulogic := Std_Ulogic'Val (R); 86 begin 87 if Left = '-' or Right = '-' then 88 Assert_Not_Match; 89 end if; 90 return Std_Ulogic'Pos (Or_Table (Match_Lt_Table (Left, Right), 91 Match_Eq_Table (Left, Right))); 92 end Ghdl_Std_Ulogic_Match_Le; 93 94 Assert_Arr_Msg : constant String := 95 "parameters of '?=' array operator are not of the same length"; 96 97 Assert_Arr_Msg_Bound : constant Std_String_Bound := 98 (Dim_1 => (Left => 1, Right => Assert_Arr_Msg'Length, Dir => Dir_To, 99 Length => Assert_Arr_Msg'Length)); 100 101 Assert_Arr_Msg_Str : aliased constant Std_String := 102 (Base => To_Std_String_Basep (Assert_Arr_Msg'Address), 103 Bounds => To_Std_String_Boundp (Assert_Arr_Msg_Bound'Address)); 104 105 function Ghdl_Std_Ulogic_Array_Match_Eq (L : Ghdl_Ptr; 106 L_Len : Ghdl_Index_Type; 107 R : Ghdl_Ptr; 108 R_Len : Ghdl_Index_Type) 109 return Ghdl_I32 110 is 111 use Grt.Lib; 112 L_Arr : constant Ghdl_E8_Array_Base_Ptr := 113 To_Ghdl_E8_Array_Base_Ptr (L); 114 R_Arr : constant Ghdl_E8_Array_Base_Ptr := 115 To_Ghdl_E8_Array_Base_Ptr (R); 116 Res : Std_Ulogic := '1'; 117 begin 118 if L_Len /= R_Len then 119 Ghdl_Ieee_Assert_Failed 120 (To_Std_String_Ptr (Assert_Arr_Msg_Str'Address), Error_Severity, 121 To_Ghdl_Location_Ptr (Loc'Address)); 122 return Std_Ulogic'Pos ('0'); 123 end if; 124 125 for I in 1 .. L_Len loop 126 declare 127 Le : constant Std_Ulogic := Std_Ulogic'Val (L_Arr (I - 1)); 128 Re : constant Std_Ulogic := Std_Ulogic'Val (R_Arr (I - 1)); 129 begin 130 Res := And_Table (Res, Match_Eq_Table (Le, Re)); 131 end; 132 end loop; 133 return Std_Ulogic'Pos (Res); 134 end Ghdl_Std_Ulogic_Array_Match_Eq; 135 136 function Ghdl_Std_Ulogic_Array_Match_Ne (L : Ghdl_Ptr; 137 L_Len : Ghdl_Index_Type; 138 R : Ghdl_Ptr; 139 R_Len : Ghdl_Index_Type) 140 return Ghdl_I32 is 141 begin 142 return Std_Ulogic'Pos 143 (Not_Table (Std_Ulogic'Val 144 (Ghdl_Std_Ulogic_Array_Match_Eq (L, L_Len, R, R_Len)))); 145 end Ghdl_Std_Ulogic_Array_Match_Ne; 146end Grt.Std_Logic_1164; 147