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