1-- -----------------------------------------------------------------
2--
3-- Copyright 2019 IEEE P1076 WG Authors
4--
5-- See the LICENSE file distributed with this work for copyright and
6-- licensing information and the AUTHORS file.
7--
8-- This file to you under the Apache License, Version 2.0 (the "License").
9-- You may obtain a copy of the License at
10--
11--     http://www.apache.org/licenses/LICENSE-2.0
12--
13-- Unless required by applicable law or agreed to in writing, software
14-- distributed under the License is distributed on an "AS IS" BASIS,
15-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
16-- implied.  See the License for the specific language governing
17-- permissions and limitations under the License.
18--
19--   Title     :  Standard multivalue logic package
20--             :  (STD_LOGIC_1164 package body)
21--             :
22--   Library   :  This package shall be compiled into a library
23--             :  symbolically named IEEE.
24--             :
25--   Developers:  IEEE model standards group (PAR 1164),
26--             :  Accellera VHDL-TC, and IEEE P1076 Working Group
27--             :
28--   Purpose   :  This packages defines a standard for designers
29--             :  to use in describing the interconnection data types
30--             :  used in vhdl modeling.
31--             :
32--   Limitation:  The logic system defined in this package may
33--             :  be insufficient for modeling switched transistors,
34--             :  since such a requirement is out of the scope of this
35--             :  effort. Furthermore, mathematics, primitives,
36--             :  timing standards, etc. are considered orthogonal
37--             :  issues as it relates to this package and are therefore
38--             :  beyond the scope of this effort.
39--             :
40--   Note      :  This package may be modified to include additional data
41--             :  required by tools, but it must in no way change the
42--             :  external interfaces or simulation behavior of the
43--             :  description. It is permissible to add comments and/or
44--             :  attributes to the package declarations, but not to change
45--             :  or delete any original lines of the package declaration.
46--             :  The package body may be changed only in accordance with
47--             :  the terms of Clause 16 of this standard.
48--             :
49-- --------------------------------------------------------------------
50-- $Revision: 1220 $
51-- $Date: 2008-04-10 17:16:09 +0930 (Thu, 10 Apr 2008) $
52-- --------------------------------------------------------------------
53
54package body std_logic_1164 is
55  -------------------------------------------------------------------
56  -- local types
57  -------------------------------------------------------------------
58  type stdlogic_1d is array (STD_ULOGIC) of STD_ULOGIC;
59  type stdlogic_table is array(STD_ULOGIC, STD_ULOGIC) of STD_ULOGIC;
60
61  -------------------------------------------------------------------
62  -- resolution function
63  -------------------------------------------------------------------
64  constant resolution_table : stdlogic_table := (
65    --      ---------------------------------------------------------
66    --      |  U    X    0    1    Z    W    L    H    -        |   |
67    --      ---------------------------------------------------------
68             ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'),  -- | U |
69             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'),  -- | X |
70             ('U', 'X', '0', 'X', '0', '0', '0', '0', 'X'),  -- | 0 |
71             ('U', 'X', 'X', '1', '1', '1', '1', '1', 'X'),  -- | 1 |
72             ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', 'X'),  -- | Z |
73             ('U', 'X', '0', '1', 'W', 'W', 'W', 'W', 'X'),  -- | W |
74             ('U', 'X', '0', '1', 'L', 'W', 'L', 'W', 'X'),  -- | L |
75             ('U', 'X', '0', '1', 'H', 'W', 'W', 'H', 'X'),  -- | H |
76             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X')   -- | - |
77             );
78
79  function resolved (s : STD_ULOGIC_VECTOR) return STD_ULOGIC is
80    variable result : STD_ULOGIC := 'Z';  -- weakest state default
81  begin
82    -- the test for a single driver is essential otherwise the
83    -- loop would return 'X' for a single driver of '-' and that
84    -- would conflict with the value of a single driver unresolved
85    -- signal.
86    if (s'length = 1) then return s(s'low);
87    else
88      for i in s'range loop
89        result := resolution_table(result, s(i));
90      end loop;
91    end if;
92    return result;
93  end function resolved;
94
95  -------------------------------------------------------------------
96  -- tables for logical operations
97  -------------------------------------------------------------------
98
99  -- truth table for "and" function
100  constant and_table : stdlogic_table := (
101    --      ----------------------------------------------------
102    --      |  U    X    0    1    Z    W    L    H    -         |   |
103    --      ----------------------------------------------------
104             ('U', 'U', '0', 'U', 'U', 'U', '0', 'U', 'U'),  -- | U |
105             ('U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X'),  -- | X |
106             ('0', '0', '0', '0', '0', '0', '0', '0', '0'),  -- | 0 |
107             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | 1 |
108             ('U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X'),  -- | Z |
109             ('U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X'),  -- | W |
110             ('0', '0', '0', '0', '0', '0', '0', '0', '0'),  -- | L |
111             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | H |
112             ('U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X')   -- | - |
113             );
114
115  -- truth table for "or" function
116  constant or_table : stdlogic_table := (
117    --      ----------------------------------------------------
118    --      |  U    X    0    1    Z    W    L    H    -         |   |
119    --      ----------------------------------------------------
120             ('U', 'U', 'U', '1', 'U', 'U', 'U', '1', 'U'),  -- | U |
121             ('U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X'),  -- | X |
122             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | 0 |
123             ('1', '1', '1', '1', '1', '1', '1', '1', '1'),  -- | 1 |
124             ('U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X'),  -- | Z |
125             ('U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X'),  -- | W |
126             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | L |
127             ('1', '1', '1', '1', '1', '1', '1', '1', '1'),  -- | H |
128             ('U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X')   -- | - |
129             );
130
131  -- truth table for "xor" function
132  constant xor_table : stdlogic_table := (
133    --      ----------------------------------------------------
134    --      |  U    X    0    1    Z    W    L    H    -         |   |
135    --      ----------------------------------------------------
136             ('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'),  -- | U |
137             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'),  -- | X |
138             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | 0 |
139             ('U', 'X', '1', '0', 'X', 'X', '1', '0', 'X'),  -- | 1 |
140             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'),  -- | Z |
141             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X'),  -- | W |
142             ('U', 'X', '0', '1', 'X', 'X', '0', '1', 'X'),  -- | L |
143             ('U', 'X', '1', '0', 'X', 'X', '1', '0', 'X'),  -- | H |
144             ('U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X')   -- | - |
145             );
146
147  -- truth table for "not" function
148  constant not_table : stdlogic_1d :=
149    --  -------------------------------------------------
150    --  |   U    X    0    1    Z    W    L    H    -   |
151    --  -------------------------------------------------
152          ('U', 'X', '1', '0', 'X', 'X', '1', '0', 'X');
153
154  -------------------------------------------------------------------
155  -- overloaded logical operators ( with optimizing hints )
156  -------------------------------------------------------------------
157
158  function "and" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
159  begin
160    return (and_table(l, r));
161  end function "and";
162
163  function "nand" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
164  begin
165    return (not_table (and_table(l, r)));
166  end function "nand";
167
168  function "or" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
169  begin
170    return (or_table(l, r));
171  end function "or";
172
173  function "nor" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
174  begin
175    return (not_table (or_table(l, r)));
176  end function "nor";
177
178  function "xor" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
179  begin
180    return (xor_table(l, r));
181  end function "xor";
182
183  function "xnor" (l : STD_ULOGIC; r : STD_ULOGIC) return UX01 is
184  begin
185    return not_table(xor_table(l, r));
186  end function "xnor";
187
188  function "not" (l : STD_ULOGIC) return UX01 is
189  begin
190    return (not_table(l));
191  end function "not";
192
193  -------------------------------------------------------------------
194  -- and
195  -------------------------------------------------------------------
196  function "and" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
197    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
198    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
199    variable result : STD_ULOGIC_VECTOR (1 to l'length);
200  begin
201    if (l'length /= r'length) then
202      assert false
203        report "STD_LOGIC_1164.""and"": "
204        & "arguments of overloaded 'and' operator are not of the same length"
205        severity failure;
206    else
207      for i in result'range loop
208        result(i) := and_table (lv(i), rv(i));
209      end loop;
210    end if;
211    return result;
212  end function "and";
213  -------------------------------------------------------------------
214  -- nand
215  -------------------------------------------------------------------
216  function "nand" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
217    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
218    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
219    variable result : STD_ULOGIC_VECTOR (1 to l'length);
220  begin
221    if (l'length /= r'length) then
222      assert false
223        report "STD_LOGIC_1164.""nand"": "
224        & "arguments of overloaded 'nand' operator are not of the same length"
225        severity failure;
226    else
227      for i in result'range loop
228        result(i) := not_table(and_table (lv(i), rv(i)));
229      end loop;
230    end if;
231    return result;
232  end function "nand";
233  -------------------------------------------------------------------
234  -- or
235  -------------------------------------------------------------------
236  function "or" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
237    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
238    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
239    variable result : STD_ULOGIC_VECTOR (1 to l'length);
240  begin
241    if (l'length /= r'length) then
242      assert false
243        report "STD_LOGIC_1164.""or"": "
244        & "arguments of overloaded 'or' operator are not of the same length"
245        severity failure;
246    else
247      for i in result'range loop
248        result(i) := or_table (lv(i), rv(i));
249      end loop;
250    end if;
251    return result;
252  end function "or";
253  -------------------------------------------------------------------
254  -- nor
255  -------------------------------------------------------------------
256  function "nor" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
257    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
258    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
259    variable result : STD_ULOGIC_VECTOR (1 to l'length);
260  begin
261    if (l'length /= r'length) then
262      assert false
263        report "STD_LOGIC_1164.""nor"": "
264        & "arguments of overloaded 'nor' operator are not of the same length"
265        severity failure;
266    else
267      for i in result'range loop
268        result(i) := not_table(or_table (lv(i), rv(i)));
269      end loop;
270    end if;
271    return result;
272  end function "nor";
273  ---------------------------------------------------------------------
274  -- xor
275  -------------------------------------------------------------------
276  function "xor" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
277    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
278    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
279    variable result : STD_ULOGIC_VECTOR (1 to l'length);
280  begin
281    if (l'length /= r'length) then
282      assert false
283        report "STD_LOGIC_1164.""xor"": "
284        & "arguments of overloaded 'xor' operator are not of the same length"
285        severity failure;
286    else
287      for i in result'range loop
288        result(i) := xor_table (lv(i), rv(i));
289      end loop;
290    end if;
291    return result;
292  end function "xor";
293  -------------------------------------------------------------------
294  -- xnor
295  -------------------------------------------------------------------
296  function "xnor" (l, r : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
297    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
298    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
299    variable result : STD_ULOGIC_VECTOR (1 to l'length);
300  begin
301    if (l'length /= r'length) then
302      assert false
303        report "STD_LOGIC_1164.""xnor"": "
304        & "arguments of overloaded 'xnor' operator are not of the same length"
305        severity failure;
306    else
307      for i in result'range loop
308        result(i) := not_table(xor_table (lv(i), rv(i)));
309      end loop;
310    end if;
311    return result;
312  end function "xnor";
313  -------------------------------------------------------------------
314  -- not
315  -------------------------------------------------------------------
316  function "not" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
317    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
318    variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => 'X');
319  begin
320    for i in result'range loop
321      result(i) := not_table(lv(i));
322    end loop;
323    return result;
324  end function "not";
325
326  -------------------------------------------------------------------
327  -- and
328  -------------------------------------------------------------------
329  function "and" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
330    return STD_ULOGIC_VECTOR
331  is
332    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
333    variable result : STD_ULOGIC_VECTOR (1 to l'length);
334  begin
335    for i in result'range loop
336      result(i) := and_table (lv(i), r);
337    end loop;
338    return result;
339  end function "and";
340  -------------------------------------------------------------------
341  function "and" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
342    return STD_ULOGIC_VECTOR
343  is
344    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
345    variable result : STD_ULOGIC_VECTOR (1 to r'length);
346  begin
347    for i in result'range loop
348      result(i) := and_table (l, rv(i));
349    end loop;
350    return result;
351  end function "and";
352
353  -------------------------------------------------------------------
354  -- nand
355  -------------------------------------------------------------------
356  function "nand" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
357    return STD_ULOGIC_VECTOR
358  is
359    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
360    variable result : STD_ULOGIC_VECTOR (1 to l'length);
361  begin
362    for i in result'range loop
363      result(i) := not_table(and_table (lv(i), r));
364    end loop;
365    return result;
366  end function "nand";
367  -------------------------------------------------------------------
368  function "nand" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
369    return STD_ULOGIC_VECTOR
370  is
371    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
372    variable result : STD_ULOGIC_VECTOR (1 to r'length);
373  begin
374    for i in result'range loop
375      result(i) := not_table(and_table (l, rv(i)));
376    end loop;
377    return result;
378  end function "nand";
379
380  -------------------------------------------------------------------
381  -- or
382  -------------------------------------------------------------------
383  function "or" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
384    return STD_ULOGIC_VECTOR
385  is
386    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
387    variable result : STD_ULOGIC_VECTOR (1 to l'length);
388  begin
389    for i in result'range loop
390      result(i) := or_table (lv(i), r);
391    end loop;
392    return result;
393  end function "or";
394  -------------------------------------------------------------------
395  function "or" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
396    return STD_ULOGIC_VECTOR
397  is
398    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
399    variable result : STD_ULOGIC_VECTOR (1 to r'length);
400  begin
401    for i in result'range loop
402      result(i) := or_table (l, rv(i));
403    end loop;
404    return result;
405  end function "or";
406
407  -------------------------------------------------------------------
408  -- nor
409  -------------------------------------------------------------------
410  function "nor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
411    return STD_ULOGIC_VECTOR
412  is
413    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
414    variable result : STD_ULOGIC_VECTOR (1 to l'length);
415  begin
416    for i in result'range loop
417      result(i) := not_table(or_table (lv(i), r));
418    end loop;
419    return result;
420  end function "nor";
421  -------------------------------------------------------------------
422  function "nor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
423    return STD_ULOGIC_VECTOR
424  is
425    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
426    variable result : STD_ULOGIC_VECTOR (1 to r'length);
427  begin
428    for i in result'range loop
429      result(i) := not_table(or_table (l, rv(i)));
430    end loop;
431    return result;
432  end function "nor";
433
434  -------------------------------------------------------------------
435  -- xor
436  -------------------------------------------------------------------
437  function "xor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
438    return STD_ULOGIC_VECTOR
439  is
440    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
441    variable result : STD_ULOGIC_VECTOR (1 to l'length);
442  begin
443    for i in result'range loop
444      result(i) := xor_table (lv(i), r);
445    end loop;
446    return result;
447  end function "xor";
448  -------------------------------------------------------------------
449  function "xor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
450    return STD_ULOGIC_VECTOR
451  is
452    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
453    variable result : STD_ULOGIC_VECTOR (1 to r'length);
454  begin
455    for i in result'range loop
456      result(i) := xor_table (l, rv(i));
457    end loop;
458    return result;
459  end function "xor";
460
461  -------------------------------------------------------------------
462  -- xnor
463  -------------------------------------------------------------------
464  function "xnor" (l : STD_ULOGIC_VECTOR; r : STD_ULOGIC)
465    return STD_ULOGIC_VECTOR
466  is
467    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
468    variable result : STD_ULOGIC_VECTOR (1 to l'length);
469  begin
470    for i in result'range loop
471      result(i) := not_table(xor_table (lv(i), r));
472    end loop;
473    return result;
474  end function "xnor";
475  -------------------------------------------------------------------
476  function "xnor" (l : STD_ULOGIC; r : STD_ULOGIC_VECTOR)
477    return STD_ULOGIC_VECTOR
478  is
479    alias rv        : STD_ULOGIC_VECTOR (1 to r'length) is r;
480    variable result : STD_ULOGIC_VECTOR (1 to r'length);
481  begin
482    for i in result'range loop
483      result(i) := not_table(xor_table (l, rv(i)));
484    end loop;
485    return result;
486  end function "xnor";
487
488  -------------------------------------------------------------------
489  -- and
490  -------------------------------------------------------------------
491  function "and" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
492    variable result : STD_ULOGIC := '1';
493  begin
494    for i in l'reverse_range loop
495      result := and_table (l(i), result);
496    end loop;
497    return result;
498  end function "and";
499
500  -------------------------------------------------------------------
501  -- nand
502  -------------------------------------------------------------------
503  function "nand" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
504    variable result : STD_ULOGIC := '1';
505  begin
506    for i in l'reverse_range loop
507      result := and_table (l(i), result);
508    end loop;
509    return not_table(result);
510  end function "nand";
511
512  -------------------------------------------------------------------
513  -- or
514  -------------------------------------------------------------------
515  function "or" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
516    variable result : STD_ULOGIC := '0';
517  begin
518    for i in l'reverse_range loop
519      result := or_table (l(i), result);
520    end loop;
521    return result;
522  end function "or";
523
524  -------------------------------------------------------------------
525  -- nor
526  -------------------------------------------------------------------
527  function "nor" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
528    variable result : STD_ULOGIC := '0';
529  begin
530    for i in l'reverse_range loop
531      result := or_table (l(i), result);
532    end loop;
533    return not_table(result);
534  end function "nor";
535
536  -------------------------------------------------------------------
537  -- xor
538  -------------------------------------------------------------------
539  function "xor" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
540    variable result : STD_ULOGIC := '0';
541  begin
542    for i in l'reverse_range loop
543      result := xor_table (l(i), result);
544    end loop;
545    return result;
546  end function "xor";
547
548  -------------------------------------------------------------------
549  -- xnor
550  -------------------------------------------------------------------
551  function "xnor" (l : STD_ULOGIC_VECTOR) return STD_ULOGIC is
552    variable result : STD_ULOGIC := '0';
553  begin
554    for i in l'reverse_range loop
555      result := xor_table (l(i), result);
556    end loop;
557    return not_table(result);
558  end function "xnor";
559
560  -------------------------------------------------------------------
561  -- shift operators
562  -------------------------------------------------------------------
563
564  -------------------------------------------------------------------
565  -- sll
566  -------------------------------------------------------------------
567  function "sll" (l : STD_ULOGIC_VECTOR; r : INTEGER)
568    return STD_ULOGIC_VECTOR
569  is
570    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
571    variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
572  begin
573    if r >= 0 then
574      result(1 to l'length - r) := lv(r + 1 to l'length);
575    else
576      result := l srl -r;
577    end if;
578    return result;
579  end function "sll";
580
581  -------------------------------------------------------------------
582  -- srl
583  -------------------------------------------------------------------
584  function "srl" (l : STD_ULOGIC_VECTOR; r : INTEGER)
585    return STD_ULOGIC_VECTOR
586  is
587    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
588    variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
589  begin
590    if r >= 0 then
591      result(r + 1 to l'length) := lv(1 to l'length - r);
592    else
593      result := l sll -r;
594    end if;
595    return result;
596  end function "srl";
597
598  -------------------------------------------------------------------
599  -- rol
600  -------------------------------------------------------------------
601  function "rol" (l : STD_ULOGIC_VECTOR; r : INTEGER)
602    return STD_ULOGIC_VECTOR
603  is
604    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
605    variable result : STD_ULOGIC_VECTOR (1 to l'length);
606    constant rm     : INTEGER := r mod l'length;
607  begin
608    if r >= 0 then
609      result(1 to l'length - rm)            := lv(rm + 1 to l'length);
610      result(l'length - rm + 1 to l'length) := lv(1 to rm);
611    else
612      result := l ror -r;
613    end if;
614    return result;
615  end function "rol";
616
617  -------------------------------------------------------------------
618  -- ror
619  -------------------------------------------------------------------
620  function "ror" (l : STD_ULOGIC_VECTOR; r : INTEGER)
621    return STD_ULOGIC_VECTOR
622  is
623    alias lv        : STD_ULOGIC_VECTOR (1 to l'length) is l;
624    variable result : STD_ULOGIC_VECTOR (1 to l'length) := (others => '0');
625    constant rm     : INTEGER := r mod l'length;
626  begin
627    if r >= 0 then
628      result(rm + 1 to l'length) := lv(1 to l'length - rm);
629      result(1 to rm)            := lv(l'length - rm + 1 to l'length);
630    else
631      result := l rol -r;
632    end if;
633    return result;
634  end function "ror";
635
636  -------------------------------------------------------------------
637  -- conversion tables
638  -------------------------------------------------------------------
639  type logic_x01_table is array (STD_ULOGIC'low to STD_ULOGIC'high) of X01;
640  type logic_x01z_table is array (STD_ULOGIC'low to STD_ULOGIC'high) of X01Z;
641  type logic_ux01_table is array (STD_ULOGIC'low to STD_ULOGIC'high) of UX01;
642  ----------------------------------------------------------
643  -- table name : cvt_to_x01
644  --
645  -- parameters :
646  --        in  :  std_ulogic  -- some logic value
647  -- returns    :  x01         -- state value of logic value
648  -- purpose    :  to convert state-strength to state only
649  --
650  -- example    : if (cvt_to_x01 (input_signal) = '1' ) then ...
651  --
652  ----------------------------------------------------------
653  constant cvt_to_x01 : logic_x01_table := (
654    'X',                                -- 'U'
655    'X',                                -- 'X'
656    '0',                                -- '0'
657    '1',                                -- '1'
658    'X',                                -- 'Z'
659    'X',                                -- 'W'
660    '0',                                -- 'L'
661    '1',                                -- 'H'
662    'X'                                 -- '-'
663    );
664
665  ----------------------------------------------------------
666  -- table name : cvt_to_x01z
667  --
668  -- parameters :
669  --        in  :  std_ulogic  -- some logic value
670  -- returns    :  x01z        -- state value of logic value
671  -- purpose    :  to convert state-strength to state only
672  --
673  -- example    : if (cvt_to_x01z (input_signal) = '1' ) then ...
674  --
675  ----------------------------------------------------------
676  constant cvt_to_x01z : logic_x01z_table := (
677    'X',                                -- 'U'
678    'X',                                -- 'X'
679    '0',                                -- '0'
680    '1',                                -- '1'
681    'Z',                                -- 'Z'
682    'X',                                -- 'W'
683    '0',                                -- 'L'
684    '1',                                -- 'H'
685    'X'                                 -- '-'
686    );
687
688  ----------------------------------------------------------
689  -- table name : cvt_to_ux01
690  --
691  -- parameters :
692  --        in  :  std_ulogic  -- some logic value
693  -- returns    :  ux01        -- state value of logic value
694  -- purpose    :  to convert state-strength to state only
695  --
696  -- example    : if (cvt_to_ux01 (input_signal) = '1' ) then ...
697  --
698  ----------------------------------------------------------
699  constant cvt_to_ux01 : logic_ux01_table := (
700    'U',                                -- 'U'
701    'X',                                -- 'X'
702    '0',                                -- '0'
703    '1',                                -- '1'
704    'X',                                -- 'Z'
705    'X',                                -- 'W'
706    '0',                                -- 'L'
707    '1',                                -- 'H'
708    'X'                                 -- '-'
709    );
710
711  -------------------------------------------------------------------
712  -- conversion functions
713  -------------------------------------------------------------------
714  function To_bit (s : STD_ULOGIC; xmap : BIT := '0') return BIT is
715  begin
716    case s is
717      when '0' | 'L' => return ('0');
718      when '1' | 'H' => return ('1');
719      when others    => return xmap;
720    end case;
721  end function To_bit;
722  --------------------------------------------------------------------
723  function To_bitvector (s : STD_ULOGIC_VECTOR; xmap : BIT := '0')
724    return BIT_VECTOR
725  is
726    alias sv        : STD_ULOGIC_VECTOR (s'length-1 downto 0) is s;
727    variable result : BIT_VECTOR (s'length-1 downto 0);
728  begin
729    for i in result'range loop
730      case sv(i) is
731        when '0' | 'L' => result(i) := '0';
732        when '1' | 'H' => result(i) := '1';
733        when others    => result(i) := xmap;
734      end case;
735    end loop;
736    return result;
737  end function To_bitvector;
738  --------------------------------------------------------------------
739  function To_StdULogic (b : BIT) return STD_ULOGIC is
740  begin
741    case b is
742      when '0' => return '0';
743      when '1' => return '1';
744    end case;
745  end function To_StdULogic;
746  --------------------------------------------------------------------
747  function To_StdLogicVector (b : BIT_VECTOR)
748    return STD_LOGIC_VECTOR
749  is
750    alias bv        : BIT_VECTOR (b'length-1 downto 0) is b;
751    variable result : STD_LOGIC_VECTOR (b'length-1 downto 0);
752  begin
753    for i in result'range loop
754      case bv(i) is
755        when '0' => result(i) := '0';
756        when '1' => result(i) := '1';
757      end case;
758    end loop;
759    return result;
760  end function To_StdLogicVector;
761  --------------------------------------------------------------------
762  function To_StdLogicVector (s : STD_ULOGIC_VECTOR)
763    return STD_LOGIC_VECTOR
764  is
765    alias sv        : STD_ULOGIC_VECTOR (s'length-1 downto 0) is s;
766    variable result : STD_LOGIC_VECTOR (s'length-1 downto 0);
767  begin
768    for i in result'range loop
769      result(i) := sv(i);
770    end loop;
771    return result;
772  end function To_StdLogicVector;
773  --------------------------------------------------------------------
774  function To_StdULogicVector (b : BIT_VECTOR)
775    return STD_ULOGIC_VECTOR
776  is
777    alias bv        : BIT_VECTOR (b'length-1 downto 0) is b;
778    variable result : STD_ULOGIC_VECTOR (b'length-1 downto 0);
779  begin
780    for i in result'range loop
781      case bv(i) is
782        when '0' => result(i) := '0';
783        when '1' => result(i) := '1';
784      end case;
785    end loop;
786    return result;
787  end function To_StdULogicVector;
788  --------------------------------------------------------------------
789  function To_StdULogicVector (s : STD_LOGIC_VECTOR)
790    return STD_ULOGIC_VECTOR
791  is
792    alias sv        : STD_LOGIC_VECTOR (s'length-1 downto 0) is s;
793    variable result : STD_ULOGIC_VECTOR (s'length-1 downto 0);
794  begin
795    for i in result'range loop
796      result(i) := sv(i);
797    end loop;
798    return result;
799  end function To_StdULogicVector;
800
801  -------------------------------------------------------------------
802  -- strength strippers and type convertors
803  -------------------------------------------------------------------
804  -- to_01
805  -------------------------------------------------------------------
806  function TO_01 (s : STD_ULOGIC_VECTOR; xmap : STD_ULOGIC := '0')
807    return STD_ULOGIC_VECTOR
808  is
809    variable RESULT      : STD_ULOGIC_VECTOR(s'length-1 downto 0);
810    variable BAD_ELEMENT : BOOLEAN := false;
811    alias XS             : STD_ULOGIC_VECTOR(s'length-1 downto 0) is s;
812  begin
813    for I in RESULT'range loop
814      case XS(I) is
815        when '0' | 'L' => RESULT(I)   := '0';
816        when '1' | 'H' => RESULT(I)   := '1';
817        when others    => BAD_ELEMENT := true;
818      end case;
819    end loop;
820    if BAD_ELEMENT then
821      for I in RESULT'range loop
822        RESULT(I) := xmap;              -- standard fixup
823      end loop;
824    end if;
825    return RESULT;
826  end function TO_01;
827  -------------------------------------------------------------------
828  function TO_01 (s : STD_ULOGIC; xmap : STD_ULOGIC := '0') return STD_ULOGIC is
829  begin
830    case s is
831      when '0' | 'L' => RETURN '0';
832      when '1' | 'H' => RETURN '1';
833      when others    => return xmap;
834    end case;
835  end function TO_01;
836  -------------------------------------------------------------------
837  function TO_01 (s : BIT_VECTOR; xmap : STD_ULOGIC := '0')
838    return STD_ULOGIC_VECTOR
839  is
840    variable RESULT : STD_ULOGIC_VECTOR(s'length-1 downto 0);
841    alias XS        : BIT_VECTOR(s'length-1 downto 0) is s;
842  begin
843    for I in RESULT'range loop
844      case XS(I) is
845        when '0' => RESULT(I) := '0';
846        when '1' => RESULT(I) := '1';
847      end case;
848    end loop;
849    return RESULT;
850  end function TO_01;
851  -------------------------------------------------------------------
852  function TO_01 (s : BIT; xmap : STD_ULOGIC := '0') return STD_ULOGIC is
853  begin
854    case s is
855      when '0' => RETURN '0';
856      when '1' => RETURN '1';
857    end case;
858  end function TO_01;
859  -------------------------------------------------------------------
860  -- to_x01
861  -------------------------------------------------------------------
862  function To_X01 (s : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
863    alias sv        : STD_ULOGIC_VECTOR (1 to s'length) is s;
864    variable result : STD_ULOGIC_VECTOR (1 to s'length);
865  begin
866    for i in result'range loop
867      result(i) := cvt_to_x01 (sv(i));
868    end loop;
869    return result;
870  end function To_X01;
871  --------------------------------------------------------------------
872  function To_X01 (s : STD_ULOGIC) return X01 is
873  begin
874    return (cvt_to_x01(s));
875  end function To_X01;
876  --------------------------------------------------------------------
877  function To_X01 (b : BIT_VECTOR) return STD_ULOGIC_VECTOR is
878    alias bv        : BIT_VECTOR (1 to b'length) is b;
879    variable result : STD_ULOGIC_VECTOR (1 to b'length);
880  begin
881    for i in result'range loop
882      case bv(i) is
883        when '0' => result(i) := '0';
884        when '1' => result(i) := '1';
885      end case;
886    end loop;
887    return result;
888  end function To_X01;
889  --------------------------------------------------------------------
890  function To_X01 (b : BIT) return X01 is
891  begin
892    case b is
893      when '0' => return('0');
894      when '1' => return('1');
895    end case;
896  end function To_X01;
897  --------------------------------------------------------------------
898  -- to_x01z
899  -------------------------------------------------------------------
900  function To_X01Z (s : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
901    alias sv        : STD_ULOGIC_VECTOR (1 to s'length) is s;
902    variable result : STD_ULOGIC_VECTOR (1 to s'length);
903  begin
904    for i in result'range loop
905      result(i) := cvt_to_x01z (sv(i));
906    end loop;
907    return result;
908  end function To_X01Z;
909  --------------------------------------------------------------------
910  function To_X01Z (s : STD_ULOGIC) return X01Z is
911  begin
912    return (cvt_to_x01z(s));
913  end function To_X01Z;
914  --------------------------------------------------------------------
915  function To_X01Z (b : BIT_VECTOR) return STD_ULOGIC_VECTOR is
916    alias bv        : BIT_VECTOR (1 to b'length) is b;
917    variable result : STD_ULOGIC_VECTOR (1 to b'length);
918  begin
919    for i in result'range loop
920      case bv(i) is
921        when '0' => result(i) := '0';
922        when '1' => result(i) := '1';
923      end case;
924    end loop;
925    return result;
926  end function To_X01Z;
927  --------------------------------------------------------------------
928  function To_X01Z (b : BIT) return X01Z is
929  begin
930    case b is
931      when '0' => return('0');
932      when '1' => return('1');
933    end case;
934  end function To_X01Z;
935  --------------------------------------------------------------------
936  -- to_ux01
937  -------------------------------------------------------------------
938  function To_UX01 (s : STD_ULOGIC_VECTOR) return STD_ULOGIC_VECTOR is
939    alias sv        : STD_ULOGIC_VECTOR (1 to s'length) is s;
940    variable result : STD_ULOGIC_VECTOR (1 to s'length);
941  begin
942    for i in result'range loop
943      result(i) := cvt_to_ux01 (sv(i));
944    end loop;
945    return result;
946  end function To_UX01;
947  --------------------------------------------------------------------
948  function To_UX01 (s : STD_ULOGIC) return UX01 is
949  begin
950    return (cvt_to_ux01(s));
951  end function To_UX01;
952  --------------------------------------------------------------------
953  function To_UX01 (b : BIT_VECTOR) return STD_ULOGIC_VECTOR is
954    alias bv        : BIT_VECTOR (1 to b'length) is b;
955    variable result : STD_ULOGIC_VECTOR (1 to b'length);
956  begin
957    for i in result'range loop
958      case bv(i) is
959        when '0' => result(i) := '0';
960        when '1' => result(i) := '1';
961      end case;
962    end loop;
963    return result;
964  end function To_UX01;
965  --------------------------------------------------------------------
966  function To_UX01 (b : BIT) return UX01 is
967  begin
968    case b is
969      when '0' => return('0');
970      when '1' => return('1');
971    end case;
972  end function To_UX01;
973
974  function "??" (l : STD_ULOGIC) return BOOLEAN is
975  begin
976    return l = '1' or l = 'H';
977  end function "??";
978
979  -------------------------------------------------------------------
980  -- edge detection
981  -------------------------------------------------------------------
982  function rising_edge (signal s : STD_ULOGIC) return BOOLEAN is
983  begin
984    return (s'event and (To_X01(s) = '1') and
985            (To_X01(s'last_value) = '0'));
986  end function rising_edge;
987
988  function falling_edge (signal s : STD_ULOGIC) return BOOLEAN is
989  begin
990    return (s'event and (To_X01(s) = '0') and
991            (To_X01(s'last_value) = '1'));
992  end function falling_edge;
993
994  -------------------------------------------------------------------
995  -- object contains an unknown
996  -------------------------------------------------------------------
997  function Is_X (s : STD_ULOGIC_VECTOR) return BOOLEAN is
998  begin
999    for i in s'range loop
1000      case s(i) is
1001        when 'U' | 'X' | 'Z' | 'W' | '-' => return true;
1002        when others                      => null;
1003      end case;
1004    end loop;
1005    return false;
1006  end function Is_X;
1007  --------------------------------------------------------------------
1008  function Is_X (s : STD_ULOGIC) return BOOLEAN is
1009  begin
1010    case s is
1011      when 'U' | 'X' | 'Z' | 'W' | '-' => return true;
1012      when others                      => null;
1013    end case;
1014    return false;
1015  end function Is_X;
1016
1017  -------------------------------------------------------------------
1018  -- string conversion and write operations
1019  -------------------------------------------------------------------
1020
1021  function TO_OSTRING (value : STD_ULOGIC_VECTOR) return STRING is
1022    constant result_length : NATURAL := (value'length+2)/3;
1023    variable pad           : STD_ULOGIC_VECTOR(1 to result_length*3 - value'length);
1024    variable padded_value  : STD_ULOGIC_VECTOR(1 to result_length*3);
1025    variable result        : STRING(1 to result_length);
1026    variable tri           : STD_ULOGIC_VECTOR(1 to 3);
1027  begin
1028    if value (value'left) = 'Z' then
1029      pad := (others => 'Z');
1030    else
1031      pad := (others => '0');
1032    end if;
1033    padded_value := pad & value;
1034    for i in 1 to result_length loop
1035      tri := To_X01Z(padded_value(3*i-2 to 3*i));
1036      case tri is
1037        when o"0"   => result(i) := '0';
1038        when o"1"   => result(i) := '1';
1039        when o"2"   => result(i) := '2';
1040        when o"3"   => result(i) := '3';
1041        when o"4"   => result(i) := '4';
1042        when o"5"   => result(i) := '5';
1043        when o"6"   => result(i) := '6';
1044        when o"7"   => result(i) := '7';
1045        when "ZZZ"  => result(i) := 'Z';
1046        when others => result(i) := 'X';
1047      end case;
1048    end loop;
1049    return result;
1050  end function TO_OSTRING;
1051
1052  function TO_HSTRING (value : STD_ULOGIC_VECTOR) return STRING is
1053    constant result_length : NATURAL := (value'length+3)/4;
1054    variable pad           : STD_ULOGIC_VECTOR(1 to result_length*4 - value'length);
1055    variable padded_value  : STD_ULOGIC_VECTOR(1 to result_length*4);
1056    variable result        : STRING(1 to result_length);
1057    variable quad          : STD_ULOGIC_VECTOR(1 to 4);
1058  begin
1059    if value (value'left) = 'Z' then
1060      pad := (others => 'Z');
1061    else
1062      pad := (others => '0');
1063    end if;
1064    padded_value := pad & value;
1065    for i in 1 to result_length loop
1066      quad := To_X01Z(padded_value(4*i-3 to 4*i));
1067      case quad is
1068        when x"0"   => result(i) := '0';
1069        when x"1"   => result(i) := '1';
1070        when x"2"   => result(i) := '2';
1071        when x"3"   => result(i) := '3';
1072        when x"4"   => result(i) := '4';
1073        when x"5"   => result(i) := '5';
1074        when x"6"   => result(i) := '6';
1075        when x"7"   => result(i) := '7';
1076        when x"8"   => result(i) := '8';
1077        when x"9"   => result(i) := '9';
1078        when x"A"   => result(i) := 'A';
1079        when x"B"   => result(i) := 'B';
1080        when x"C"   => result(i) := 'C';
1081        when x"D"   => result(i) := 'D';
1082        when x"E"   => result(i) := 'E';
1083        when x"F"   => result(i) := 'F';
1084        when "ZZZZ" => result(i) := 'Z';
1085        when others => result(i) := 'X';
1086      end case;
1087    end loop;
1088    return result;
1089  end function TO_HSTRING;
1090
1091  -- Type and constant definitions used to map STD_ULOGIC values
1092  -- into/from character values.
1093  type MVL9plus is ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-', error);
1094  type char_indexed_by_MVL9 is array (STD_ULOGIC) of CHARACTER;
1095  type MVL9_indexed_by_char is array (CHARACTER) of STD_ULOGIC;
1096  type MVL9plus_indexed_by_char is array (CHARACTER) of MVL9plus;
1097  constant MVL9_to_char : char_indexed_by_MVL9 := "UX01ZWLH-";
1098  constant char_to_MVL9 : MVL9_indexed_by_char :=
1099    ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
1100     'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => 'U');
1101  constant char_to_MVL9plus : MVL9plus_indexed_by_char :=
1102    ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z',
1103     'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => error);
1104
1105  constant NBSP : CHARACTER := CHARACTER'val(160);  -- space character
1106
1107  -- purpose: Skips white space
1108  procedure skip_whitespace (
1109    L : inout LINE) is
1110    variable c : CHARACTER;
1111    variable left : positive;
1112  begin
1113    while L /= null and L.all'length /= 0 loop
1114      left := L.all'left;
1115      c := L.all(left);
1116      if (c = ' ' or c = NBSP or c = HT) then
1117        read (L, c);
1118      else
1119        exit;
1120      end if;
1121    end loop;
1122  end procedure skip_whitespace;
1123
1124  procedure READ (L    : inout LINE; VALUE : out STD_ULOGIC;
1125                  GOOD : out   BOOLEAN) is
1126    variable c      : CHARACTER;
1127    variable readOk : BOOLEAN;
1128  begin
1129    VALUE := 'U';                       -- initialize to a "U"
1130    skip_whitespace (L);
1131    read (L, c, readOk);
1132    if not readOk then
1133      GOOD := false;
1134    else
1135      if char_to_MVL9plus(c) = error then
1136        GOOD := false;
1137      else
1138        VALUE := char_to_MVL9(c);
1139        GOOD  := true;
1140      end if;
1141    end if;
1142  end procedure READ;
1143
1144  procedure READ (L    : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
1145                  GOOD : out   BOOLEAN) is
1146    variable c      : CHARACTER;
1147    variable mv     : STD_ULOGIC_VECTOR(0 to VALUE'length-1);
1148    variable readOk : BOOLEAN;
1149    variable i      : INTEGER;
1150    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1151  begin
1152    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1153    skip_whitespace (L);
1154    if VALUE'length > 0 then
1155      read (L, c, readOk);
1156      i := 0;
1157      GOOD := true;
1158      while i < VALUE'length loop
1159        if not readOk then     -- Bail out if there was a bad read
1160          GOOD := false;
1161          return;
1162        elsif c = '_' then
1163          if i = 0 then
1164            GOOD := false;                -- Begins with an "_"
1165            return;
1166          elsif lastu then
1167            GOOD := false;                -- "__" detected
1168            return;
1169          else
1170            lastu := true;
1171          end if;
1172        elsif (char_to_MVL9plus(c) = error) then
1173          GOOD := false;                  -- Illegal character
1174          return;
1175        else
1176          mv(i) := char_to_MVL9(c);
1177          i := i + 1;
1178          if i > mv'high then             -- reading done
1179            VALUE := mv;
1180            return;
1181          end if;
1182          lastu := false;
1183        end if;
1184        read(L, c, readOk);
1185      end loop;
1186    else
1187      GOOD := true;                   -- read into a null array
1188    end if;
1189  end procedure READ;
1190
1191  procedure READ (L : inout LINE; VALUE : out STD_ULOGIC) is
1192    variable c      : CHARACTER;
1193    variable readOk : BOOLEAN;
1194  begin
1195    VALUE := 'U';                       -- initialize to a "U"
1196    skip_whitespace (L);
1197    read (L, c, readOk);
1198    if not readOk then
1199      report "STD_LOGIC_1164.READ(STD_ULOGIC) "
1200        & "End of string encountered"
1201        severity error;
1202      return;
1203    elsif char_to_MVL9plus(c) = error then
1204      report
1205        "STD_LOGIC_1164.READ(STD_ULOGIC) Error: Character '" &
1206        c & "' read, expected STD_ULOGIC literal."
1207        severity error;
1208    else
1209      VALUE := char_to_MVL9(c);
1210    end if;
1211  end procedure READ;
1212
1213  procedure READ (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
1214    variable c      : CHARACTER;
1215    variable readOk : BOOLEAN;
1216    variable mv     : STD_ULOGIC_VECTOR(0 to VALUE'length-1);
1217    variable i      : INTEGER;
1218    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1219  begin
1220    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1221    skip_whitespace (L);
1222    if VALUE'length > 0 then            -- non Null input string
1223      read (L, c, readOk);
1224      i := 0;
1225      while i < VALUE'length loop
1226        if readOk = false then              -- Bail out if there was a bad read
1227          report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
1228            & "End of string encountered"
1229            severity error;
1230          return;
1231        elsif c = '_' then
1232          if i = 0 then
1233            report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
1234              & "String begins with an ""_""" severity error;
1235            return;
1236          elsif lastu then
1237            report "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) "
1238              & "Two underscores detected in input string ""__"""
1239              severity error;
1240            return;
1241          else
1242            lastu := true;
1243          end if;
1244        elsif char_to_MVL9plus(c) = error then
1245          report
1246            "STD_LOGIC_1164.READ(STD_ULOGIC_VECTOR) Error: Character '" &
1247            c & "' read, expected STD_ULOGIC literal."
1248            severity error;
1249          return;
1250        else
1251          mv(i) := char_to_MVL9(c);
1252          i := i + 1;
1253          if i > mv'high then
1254            VALUE := mv;
1255            return;
1256          end if;
1257          lastu := false;
1258        end if;
1259        read(L, c, readOk);
1260      end loop;
1261    end if;
1262  end procedure READ;
1263
1264  procedure WRITE (L         : inout LINE; VALUE : in STD_ULOGIC;
1265                   JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0) is
1266  begin
1267    write(L, MVL9_to_char(VALUE), JUSTIFIED, FIELD);
1268  end procedure WRITE;
1269
1270  procedure WRITE (L         : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
1271                   JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0) is
1272    variable s : STRING(1 to VALUE'length);
1273    alias m    : STD_ULOGIC_VECTOR(1 to VALUE'length) is VALUE;
1274  begin
1275    for i in 1 to VALUE'length loop
1276      s(i) := MVL9_to_char(m(i));
1277    end loop;
1278    write(L, s, JUSTIFIED, FIELD);
1279  end procedure WRITE;
1280
1281  procedure Char2TriBits (C           : in  CHARACTER;
1282                          RESULT      : out STD_ULOGIC_VECTOR(2 downto 0);
1283                          GOOD        : out BOOLEAN;
1284                          ISSUE_ERROR : in  BOOLEAN) is
1285  begin
1286    case C is
1287      when '0' => RESULT := o"0"; GOOD := true;
1288      when '1' => RESULT := o"1"; GOOD := true;
1289      when '2' => RESULT := o"2"; GOOD := true;
1290      when '3' => RESULT := o"3"; GOOD := true;
1291      when '4' => RESULT := o"4"; GOOD := true;
1292      when '5' => RESULT := o"5"; GOOD := true;
1293      when '6' => RESULT := o"6"; GOOD := true;
1294      when '7' => RESULT := o"7"; GOOD := true;
1295      when 'Z' => RESULT := "ZZZ"; GOOD := true;
1296      when 'X' => RESULT := "XXX"; GOOD := true;
1297      when others =>
1298        assert not ISSUE_ERROR
1299          report
1300          "STD_LOGIC_1164.OREAD Error: Read a '" & C &
1301          "', expected an Octal character (0-7)."
1302          severity error;
1303        GOOD := false;
1304    end case;
1305  end procedure Char2TriBits;
1306
1307  procedure OREAD (L    : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
1308                   GOOD : out   BOOLEAN) is
1309    variable ok  : BOOLEAN;
1310    variable c   : CHARACTER;
1311    constant ne  : INTEGER := (VALUE'length+2)/3;
1312    constant pad : INTEGER := ne*3 - VALUE'length;
1313    variable sv  : STD_ULOGIC_VECTOR(0 to ne*3 - 1);
1314    variable i   : INTEGER;
1315    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1316  begin
1317    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1318    skip_whitespace (L);
1319    if VALUE'length > 0 then
1320      read (L, c, ok);
1321      i := 0;
1322      while i < ne loop
1323        -- Bail out if there was a bad read
1324        if not ok then
1325          GOOD := false;
1326          return;
1327        elsif c = '_' then
1328          if i = 0 then
1329            GOOD := false;                -- Begins with an "_"
1330            return;
1331          elsif lastu then
1332            GOOD := false;                -- "__" detected
1333            return;
1334          else
1335            lastu := true;
1336          end if;
1337        else
1338          Char2TriBits(c, sv(3*i to 3*i+2), ok, false);
1339          if not ok then
1340            GOOD := false;
1341            return;
1342          end if;
1343          i := i + 1;
1344          lastu := false;
1345        end if;
1346        if i < ne then
1347          read(L, c, ok);
1348        end if;
1349      end loop;
1350      if or (sv (0 to pad-1)) = '1' then
1351        GOOD := false;                           -- vector was truncated.
1352      else
1353        GOOD  := true;
1354        VALUE := sv (pad to sv'high);
1355      end if;
1356    else
1357      GOOD := true;                  -- read into a null array
1358    end if;
1359  end procedure OREAD;
1360
1361  procedure OREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
1362    variable c   : CHARACTER;
1363    variable ok  : BOOLEAN;
1364    constant ne  : INTEGER := (VALUE'length+2)/3;
1365    constant pad : INTEGER := ne*3 - VALUE'length;
1366    variable sv  : STD_ULOGIC_VECTOR(0 to ne*3 - 1);
1367    variable i   : INTEGER;
1368    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1369  begin
1370    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1371    skip_whitespace (L);
1372    if VALUE'length > 0 then
1373      read (L, c, ok);
1374      i := 0;
1375      while i < ne loop
1376        -- Bail out if there was a bad read
1377        if not ok then
1378          report "STD_LOGIC_1164.OREAD "
1379            & "End of string encountered"
1380            severity error;
1381          return;
1382        elsif c = '_' then
1383          if i = 0 then
1384            report "STD_LOGIC_1164.OREAD "
1385              & "String begins with an ""_""" severity error;
1386            return;
1387          elsif lastu then
1388            report "STD_LOGIC_1164.OREAD "
1389              & "Two underscores detected in input string ""__"""
1390              severity error;
1391            return;
1392          else
1393            lastu := true;
1394          end if;
1395        else
1396          Char2TriBits(c, sv(3*i to 3*i+2), ok, true);
1397          if not ok then
1398            return;
1399          end if;
1400          i := i + 1;
1401          lastu := false;
1402        end if;
1403        if i < ne then
1404          read(L, c, ok);
1405        end if;
1406      end loop;
1407      if or (sv (0 to pad-1)) = '1' then
1408        report "STD_LOGIC_1164.OREAD Vector truncated"
1409          severity error;
1410      else
1411        VALUE := sv (pad to sv'high);
1412      end if;
1413    end if;
1414  end procedure OREAD;
1415
1416  procedure Char2QuadBits (C           :     CHARACTER;
1417                           RESULT      : out STD_ULOGIC_VECTOR(3 downto 0);
1418                           GOOD        : out BOOLEAN;
1419                           ISSUE_ERROR : in  BOOLEAN) is
1420  begin
1421    case C is
1422      when '0'       => RESULT := x"0"; GOOD := true;
1423      when '1'       => RESULT := x"1"; GOOD := true;
1424      when '2'       => RESULT := x"2"; GOOD := true;
1425      when '3'       => RESULT := x"3"; GOOD := true;
1426      when '4'       => RESULT := x"4"; GOOD := true;
1427      when '5'       => RESULT := x"5"; GOOD := true;
1428      when '6'       => RESULT := x"6"; GOOD := true;
1429      when '7'       => RESULT := x"7"; GOOD := true;
1430      when '8'       => RESULT := x"8"; GOOD := true;
1431      when '9'       => RESULT := x"9"; GOOD := true;
1432      when 'A' | 'a' => RESULT := x"A"; GOOD := true;
1433      when 'B' | 'b' => RESULT := x"B"; GOOD := true;
1434      when 'C' | 'c' => RESULT := x"C"; GOOD := true;
1435      when 'D' | 'd' => RESULT := x"D"; GOOD := true;
1436      when 'E' | 'e' => RESULT := x"E"; GOOD := true;
1437      when 'F' | 'f' => RESULT := x"F"; GOOD := true;
1438      when 'Z'       => RESULT := "ZZZZ"; GOOD := true;
1439      when 'X'       => RESULT := "XXXX"; GOOD := true;
1440      when others =>
1441        assert not ISSUE_ERROR
1442          report
1443          "STD_LOGIC_1164.HREAD Error: Read a '" & C &
1444          "', expected a Hex character (0-F)."
1445          severity error;
1446        GOOD := false;
1447    end case;
1448  end procedure Char2QuadBits;
1449
1450  procedure HREAD (L    : inout LINE; VALUE : out STD_ULOGIC_VECTOR;
1451                   GOOD : out   BOOLEAN) is
1452    variable ok  : BOOLEAN;
1453    variable c   : CHARACTER;
1454    constant ne  : INTEGER := (VALUE'length+3)/4;
1455    constant pad : INTEGER := ne*4 - VALUE'length;
1456    variable sv  : STD_ULOGIC_VECTOR(0 to ne*4 - 1);
1457    variable i   : INTEGER;
1458    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1459  begin
1460    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1461    skip_whitespace (L);
1462    if VALUE'length > 0 then
1463      read (L, c, ok);
1464      i := 0;
1465      while i < ne loop
1466        -- Bail out if there was a bad read
1467        if not ok then
1468          GOOD := false;
1469          return;
1470        elsif c = '_' then
1471          if i = 0 then
1472            GOOD := false;                -- Begins with an "_"
1473            return;
1474          elsif lastu then
1475            GOOD := false;                -- "__" detected
1476            return;
1477          else
1478            lastu := true;
1479          end if;
1480        else
1481          Char2QuadBits(c, sv(4*i to 4*i+3), ok, false);
1482          if not ok then
1483            GOOD := false;
1484            return;
1485          end if;
1486          i := i + 1;
1487          lastu := false;
1488        end if;
1489        if i < ne then
1490          read(L, c, ok);
1491        end if;
1492      end loop;
1493      if or (sv (0 to pad-1)) = '1' then
1494        GOOD := false;                           -- vector was truncated.
1495      else
1496        GOOD  := true;
1497        VALUE := sv (pad to sv'high);
1498      end if;
1499    else
1500      GOOD := true;                     -- Null input string, skips whitespace
1501    end if;
1502  end procedure HREAD;
1503
1504  procedure HREAD (L : inout LINE; VALUE : out STD_ULOGIC_VECTOR) is
1505    variable ok  : BOOLEAN;
1506    variable c   : CHARACTER;
1507    constant ne  : INTEGER := (VALUE'length+3)/4;
1508    constant pad : INTEGER := ne*4 - VALUE'length;
1509    variable sv  : STD_ULOGIC_VECTOR(0 to ne*4 - 1);
1510    variable i   : INTEGER;
1511    variable lastu  : BOOLEAN := false;       -- last character was an "_"
1512  begin
1513    VALUE := (VALUE'range => 'U'); -- initialize to a "U"
1514    skip_whitespace (L);
1515    if VALUE'length > 0 then           -- non Null input string
1516      read (L, c, ok);
1517      i := 0;
1518      while i < ne loop
1519        -- Bail out if there was a bad read
1520        if not ok then
1521          report "STD_LOGIC_1164.HREAD "
1522            & "End of string encountered"
1523            severity error;
1524          return;
1525        end if;
1526        if c = '_' then
1527          if i = 0 then
1528            report "STD_LOGIC_1164.HREAD "
1529              & "String begins with an ""_""" severity error;
1530            return;
1531          elsif lastu then
1532            report "STD_LOGIC_1164.HREAD "
1533              & "Two underscores detected in input string ""__"""
1534              severity error;
1535            return;
1536          else
1537            lastu := true;
1538          end if;
1539        else
1540          Char2QuadBits(c, sv(4*i to 4*i+3), ok, true);
1541          if not ok then
1542            return;
1543          end if;
1544          i := i + 1;
1545          lastu := false;
1546        end if;
1547        if i < ne then
1548          read(L, c, ok);
1549        end if;
1550      end loop;
1551      if or (sv (0 to pad-1)) = '1' then
1552        report "STD_LOGIC_1164.HREAD Vector truncated"
1553          severity error;
1554      else
1555        VALUE := sv (pad to sv'high);
1556      end if;
1557    end if;
1558  end procedure HREAD;
1559
1560  procedure OWRITE (L         : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
1561                    JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0) is
1562  begin
1563    write (L, TO_OSTRING(VALUE), JUSTIFIED, FIELD);
1564  end procedure OWRITE;
1565
1566  procedure HWRITE (L         : inout LINE; VALUE : in STD_ULOGIC_VECTOR;
1567                    JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0) is
1568  begin
1569    write (L, TO_HSTRING (VALUE), JUSTIFIED, FIELD);
1570  end procedure HWRITE;
1571
1572end package body std_logic_1164;
1573