------------------------------------------------------------------------------
-- "standard_textio_additions" package contains the additions to the built in
-- "standard.textio" package.
-- This package should be compiled into "ieee_proposed" and used as follows:
-- use ieee_proposed.standard_textio_additions.all;
-- Last Modified: $Date: 2005-07-22 14:29:19-04 $
-- RCS ID: $Id: standard_textio_additions_c.vhd,v 1.3 2005-07-22 14:29:19-04 l435385 Exp $
--
--  Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
------------------------------------------------------------------------------
use work.standard_additions.all;        -- %%% For testing only.
use std.textio.all;                     -- %%% For testing only.
package standard_textio_additions is
  -- pragma synthesis_off
  -- Writes L to a file and to the OUTPUT.  Similar to the UNIX tee command
  procedure tee (FILE F : TEXT; variable L : inout LINE);

  -- Read and Write procedure for strings
  -- token based string read.  STRLEN = 0 if the String read is bad
  procedure SREAD (L : inout LINE; VALUE : out STRING; STRLEN : out natural);
  --  alias SWRITE is WRITE [LINE, STRING, SIDE, WIDTH];
  procedure SWRITE (L : inout LINE; VALUE : in STRING;
                    JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);

  -- Read and Write procedures for Hexadecimal values
  procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
  procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR);

  procedure HWRITE (L : inout LINE; VALUE : in BIT_VECTOR;
                    JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);

  -- Read and Write procedures for Octal values
  procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
  procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR);

  procedure OWRITE (L : inout LINE; VALUE : in BIT_VECTOR;
                    JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);

  -- Read and Write procedures for Binary values
--  alias BREAD is READ [LINE, BIT_VECTOR, BOOLEAN];
--  alias BREAD is READ [LINE, BIT_VECTOR];
--  alias BWRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
  procedure BREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
  procedure BREAD (L : inout LINE; VALUE : out BIT_VECTOR);
  procedure BWRITE (L : inout LINE; VALUE : in BIT_VECTOR;
                    JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);

  -- read and write for vector versions
  -- These versions produce "value1, value2, value3 ...."
  procedure read (L : inout LINE; VALUE : out boolean_vector;
                  GOOD : out BOOLEAN);
  procedure read (L : inout LINE; VALUE : out boolean_vector);
  procedure write (L : inout LINE; VALUE : in boolean_vector;
                   JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
  procedure read (L : inout LINE; VALUE : out integer_vector;
                  GOOD : out BOOLEAN);
  procedure read (L : inout LINE; VALUE : out integer_vector);
  procedure write (L : inout LINE; VALUE : in integer_vector;
                   JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0);
  procedure read (L : inout LINE; VALUE : out real_vector;
                  GOOD : out BOOLEAN);
  procedure read (L : inout LINE; VALUE : out real_vector);
  procedure write (L : inout LINE; VALUE : in real_vector;
                   JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0;
                   DIGITS : in NATURAL := 0);
  procedure read (L : inout LINE; VALUE : out time_vector;
                  GOOD : out BOOLEAN);
  procedure read (L : inout LINE; VALUE : out time_vector);
  procedure write (L : inout LINE; VALUE : in time_vector;
                   JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0;
                   UNIT : in TIME := ns);

  -- to_string routines
  -- Justify a string left or right, for a given width
  function justify (
    VALUE     : in STRING;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0)
    return STRING;
  -- Bit vector to string
  function to_string (
    VALUE     : in BIT_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  -- bit_vector to binary string (alias)
  alias to_bstring is to_string [BIT_VECTOR, SIDE, WIDTH return STRING];
  -- bit_vector to Hex string
  function to_hstring (
    VALUE     : in BIT_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  -- bit_vector to Octal string
  function to_ostring (
    VALUE     : in BIT_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;

  -- to_string functions for the type from std.standard
  function to_string (
    VALUE     : in INTEGER;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in BIT;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in BOOLEAN;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in SEVERITY_LEVEL;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in FILE_OPEN_KIND;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in FILE_OPEN_STATUS;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in SIDE;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  -- returns number of digits, similar to write (REAL, SIDE, FIELD, DIGITS)
  function to_string (
    VALUE     : in REAL;
    JUSTIFIED : in SIDE    := right;
    FIELD     : in WIDTH   := 0;
    DIGITS    : in NATURAL := 0
    ) return STRING ;
  -- Format is similar to the C printf format " " means real'image
  -- Example to_string (3.14159, "%5.3f") returns "3.142"
  function to_string (
    VALUE  : in REAL;
    format : in STRING
    ) return STRING ;
  -- Returns the time in the units specified.
  -- similar to write (TIME, SIDE, FIELD, UNIT);
  function to_string (
    VALUE     : in TIME;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0;
    UNIT      : in TIME  := ns
    ) return STRING ;

  -- vector versions
  function to_string (
    VALUE     : in BOOLEAN_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in INTEGER_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING ;
  function to_string (
    VALUE     : in REAL_VECTOR;
    JUSTIFIED : in SIDE    := right;
    FIELD     : in WIDTH   := 0;
    DIGITS    : in NATURAL := 0
    ) return STRING ;
  function to_string (
    VALUE  : in REAL_VECTOR;
    format : in STRING
    ) return STRING ;
  function to_string (
    VALUE     : in TIME_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0;
    UNIT      : in TIME  := ns
    ) return STRING ;

-- pragma synthesis_on
  -- Will be implicit
  function minimum (L, R : SIDE) return SIDE;
  function maximum (L, R : SIDE) return SIDE;
end package standard_textio_additions;

package body standard_textio_additions is
-- pragma synthesis_off
  constant NUS  : STRING(2 to 1) := (others => ' ');     -- NULL array
  constant NBSP : CHARACTER      := CHARACTER'val(160);  -- space character

  -- Writes L to a file without modifying the contents of the line
  procedure tee (file F : TEXT; variable L : inout LINE) is
  begin
    write (OUTPUT, L.all & NL);
    writeline(F, L);
  end procedure tee;

  -- Read and Write procedure for strings
  procedure SREAD (L      : inout LINE;
                   VALUE  : out   STRING;
                   STRLEN : out   natural) is
    variable ok     : BOOLEAN;
    variable c      : CHARACTER;
    -- Result is padded with space characters
    variable result : STRING (1 to VALUE'length) := (others => ' ');
  begin
    VALUE := result;
    loop                                -- skip white space
      read(L, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      STRLEN := 0;
      return;
    end if;
    result (1) := c;
    STRLEN     := 1;
    for i in 2 to VALUE'length loop
      read(L, c, ok);
      if (ok = false) or ((c = ' ') or (c = NBSP) or (c = HT)) then
        exit;
      else
        result (i) := c;
      end if;
      STRLEN := i;
    end loop;
    VALUE := result;
  end procedure SREAD;

  -- alias SWRITE is WRITE [LINE, STRING, SIDE, WIDTH];
  procedure SWRITE (L         : inout LINE;
                    VALUE     : in    STRING;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    WRITE (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure SWRITE;
  -- Hex Read and Write procedures for bit_vector.
  -- Procedure only visible internally.
  procedure Char2QuadBits (C           :     CHARACTER;
                           RESULT      : out BIT_VECTOR(3 downto 0);
                           GOOD        : out BOOLEAN;
                           ISSUE_ERROR : in  BOOLEAN) is
  begin
    case c is
      when '0'       => result := x"0"; good := true;
      when '1'       => result := x"1"; good := true;
      when '2'       => result := x"2"; good := true;
      when '3'       => result := x"3"; good := true;
      when '4'       => result := x"4"; good := true;
      when '5'       => result := x"5"; good := true;
      when '6'       => result := x"6"; good := true;
      when '7'       => result := x"7"; good := true;
      when '8'       => result := x"8"; good := true;
      when '9'       => result := x"9"; good := true;
      when 'A' | 'a' => result := x"A"; good := true;
      when 'B' | 'b' => result := x"B"; good := true;
      when 'C' | 'c' => result := x"C"; good := true;
      when 'D' | 'd' => result := x"D"; good := true;
      when 'E' | 'e' => result := x"E"; good := true;
      when 'F' | 'f' => result := x"F"; good := true;
      when others    =>
        assert not ISSUE_ERROR report
          "TEXTIO.HREAD Error: Read a '" & c &
          "', expected a Hex character (0-F)." severity error;
        GOOD := false;
    end case;
  end procedure Char2QuadBits;

  procedure HREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR;
                   GOOD  : out   BOOLEAN) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                    := (VALUE'length+3)/4;
    constant pad : INTEGER                    := ne*4 - VALUE'length;
    variable sv  : BIT_VECTOR (0 to ne*4 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE (VALUE'range) := (others => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      GOOD := false;
      return;
    end if;
    Char2QuadBits(c, sv(0 to 3), ok, false);
    if not ok then
      GOOD := false;
      return;
    end if;
    read(L, s, ok);
    if not ok then
      GOOD := false;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false);
      if not ok then
        GOOD := false;
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      GOOD := false;                    -- vector was truncated.
    else
      GOOD  := true;
      VALUE := sv (pad to sv'high);
    end if;
  end procedure HREAD;

  procedure HREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                   := (VALUE'length+3)/4;
    constant pad : INTEGER                   := ne*4 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*4 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE (VALUE'range) := (others => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      report "TEXTIO.HREAD Error: Failed skipping white space"
        severity error;
      return;
    end if;
    Char2QuadBits(c, sv(0 to 3), ok, true);
    if not ok then
      return;
    end if;
    read(L, s, ok);
    if not ok then
      report "TEXTIO.HREAD Error: Failed to read the STRING"
        severity error;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true);
      if not ok then
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      report "TEXTIO.HREAD Error: Vector truncated"
        severity error;
    else
      VALUE := sv (pad to sv'high);
    end if;
  end procedure HREAD;

  procedure HWRITE (L         : inout LINE;
                    VALUE     : in    BIT_VECTOR;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    write (L         => L,
           VALUE     => to_hstring(VALUE),
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure HWRITE;

  -- Procedure only visible internally.
  procedure Char2TriBits (C           :     CHARACTER;
                          RESULT      : out BIT_VECTOR(2 downto 0);
                          GOOD        : out BOOLEAN;
                          ISSUE_ERROR : in  BOOLEAN) is
  begin
    case c is
      when '0'    => result := o"0"; good := true;
      when '1'    => result := o"1"; good := true;
      when '2'    => result := o"2"; good := true;
      when '3'    => result := o"3"; good := true;
      when '4'    => result := o"4"; good := true;
      when '5'    => result := o"5"; good := true;
      when '6'    => result := o"6"; good := true;
      when '7'    => result := o"7"; good := true;
      when others =>
        assert not ISSUE_ERROR
          report
          "TEXTIO.OREAD Error: Read a '" & c &
          "', expected an Octal character (0-7)."
          severity error;
        GOOD := false;
    end case;
  end procedure Char2TriBits;

  -- Read and Write procedures for Octal values
  procedure OREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR;
                   GOOD  : out   BOOLEAN) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                   := (VALUE'length+2)/3;
    constant pad : INTEGER                   := ne*3 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE (VALUE'range) := (others => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      GOOD := false;
      return;
    end if;
    Char2TriBits(c, sv(0 to 2), ok, false);
    if not ok then
      GOOD := false;
      return;
    end if;
    read(L, s, ok);
    if not ok then
      GOOD := false;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false);
      if not ok then
        GOOD := false;
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      GOOD := false;                    -- vector was truncated.
    else
      GOOD  := true;
      VALUE := sv (pad to sv'high);
    end if;
  end procedure OREAD;

  procedure OREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR) is
    variable c   : CHARACTER;
    variable ok  : BOOLEAN;
    constant ne  : INTEGER                   := (VALUE'length+2)/3;
    constant pad : INTEGER                   := ne*3 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE (VALUE'range) := (others => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      report "TEXTIO.OREAD Error: Failed skipping white space"
        severity error;
      return;
    end if;
    Char2TriBits(c, sv(0 to 2), ok, true);
    if not ok then
      return;
    end if;
    read(L, s, ok);
    if not ok then
      report "TEXTIO.OREAD Error: Failed to read the STRING"
        severity error;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true);
      if not ok then
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      report "TEXTIO.OREAD Error: Vector truncated"
        severity error;
    else
      VALUE := sv (pad to sv'high);
    end if;
  end procedure OREAD;

  procedure OWRITE (L         : inout LINE;
                    VALUE     : in    BIT_VECTOR;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    write (L         => L,
           VALUE     => to_ostring(VALUE),
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure OWRITE;

  -- Read and Write procedures for Binary values
  -- alias BREAD is READ [LINE, BIT_VECTOR, BOOLEAN];
  -- alias BREAD is READ [LINE, BIT_VECTOR];
  -- alias BWRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
  procedure BREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR;
                   GOOD  : out   BOOLEAN) is
  begin
    read (L     => L,
          VALUE => VALUE,
          GOOD  => GOOD);
  end procedure BREAD;
  procedure BREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR) is
  begin
    read (L     => L,
          VALUE => VALUE);
  end procedure BREAD;
  -- alias BWRITE
  procedure BWRITE (L         : inout LINE;
                    VALUE     : in    BIT_VECTOR;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure BWRITE;

  -- read and write for vector versions
  -- These versions produce "value1, value2, value3 ...."
  procedure read (L     : inout LINE;
                  VALUE : out   boolean_vector;
                  GOOD  : out   BOOLEAN) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN := true;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            GOOD  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        good := false;
        return;
      end if;
    end loop;
    good := true;
  end procedure read;
  procedure read (L     : inout LINE;
                  VALUE : out   boolean_vector) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            good  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        report "STANDARD.STD_TEXTIO(BOOLEAN_VECTOR) "
          & "Read error ecounted during vector read" severity error;
        return;
      end if;
    end loop;
  end procedure read;
  procedure write (L         : inout LINE;
                   VALUE     : in    boolean_vector;
                   JUSTIFIED : in    SIDE  := right;
                   FIELD     : in    WIDTH := 0) is
  begin
    for i in VALUE'range loop
      write (L         => L,
             VALUE     => VALUE(i),
             JUSTIFIED => JUSTIFIED,
             FIELD     => FIELD);
      if (i /= value'right) then
        swrite (L, ", ");
      end if;
    end loop;
  end procedure write;
  procedure read (L     : inout LINE;
                  VALUE : out   integer_vector;
                  GOOD  : out   BOOLEAN) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN := true;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            GOOD  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        good := false;
        return;
      end if;
    end loop;
    good := true;
  end procedure read;
  procedure read (L     : inout LINE;
                  VALUE : out   integer_vector) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            good  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        report "STANDARD.STD_TEXTIO(INTEGER_VECTOR) "
          & "Read error ecounted during vector read" severity error;
        return;
      end if;
    end loop;
  end procedure read;
  procedure write (L         : inout LINE;
                   VALUE     : in    integer_vector;
                   JUSTIFIED : in    SIDE  := right;
                   FIELD     : in    WIDTH := 0) is
  begin
    for i in VALUE'range loop
      write (L         => L,
             VALUE     => VALUE(i),
             JUSTIFIED => JUSTIFIED,
             FIELD     => FIELD);
      if (i /= value'right) then
        swrite (L, ", ");
      end if;
    end loop;
  end procedure write;
  procedure read (L     : inout LINE;
                  VALUE : out   real_vector;
                  GOOD  : out   BOOLEAN) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN := true;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            GOOD  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        good := false;
        return;
      end if;
    end loop;
    good := true;
  end procedure read;
  procedure read (L     : inout LINE;
                  VALUE : out   real_vector) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            good  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        report "STANDARD.STD_TEXTIO(REAL_VECTOR) "
          & "Read error ecounted during vector read" severity error;
        return;
      end if;
    end loop;
  end procedure read;
  procedure write (L         : inout LINE;
                   VALUE     : in    real_vector;
                   JUSTIFIED : in    SIDE    := right;
                   FIELD     : in    WIDTH   := 0;
                   DIGITS    : in    NATURAL := 0) is
  begin
    for i in VALUE'range loop
      write (L         => L,
             VALUE     => VALUE(i),
             JUSTIFIED => JUSTIFIED,
             FIELD     => FIELD,
             DIGITS    => DIGITS);
      if (i /= value'right) then
        swrite (L, ", ");
      end if;
    end loop;
  end procedure write;
  procedure read (L     : inout LINE;
                  VALUE : out   time_vector;
                  GOOD  : out   BOOLEAN) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN := true;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            GOOD  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        good := false;
        return;
      end if;
    end loop;
    good := true;
  end procedure read;
  procedure read (L     : inout LINE;
                  VALUE : out   time_vector) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            good  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        report "STANDARD.STD_TEXTIO(TIME_VECTOR) "
          & "Read error ecounted during vector read" severity error;
        return;
      end if;
    end loop;
  end procedure read;
  procedure write (L         : inout LINE;
                   VALUE     : in    time_vector;
                   JUSTIFIED : in    SIDE  := right;
                   FIELD     : in    WIDTH := 0;
                   UNIT      : in    TIME  := ns) is
  begin
    for i in VALUE'range loop
      write (L         => L,
             VALUE     => VALUE(i),
             JUSTIFIED => JUSTIFIED,
             FIELD     => FIELD,
             UNIT      => UNIT);
      if (i /= value'right) then
        swrite (L, ", ");
      end if;
    end loop;
  end procedure write;

-------------------------------------------------------------------    
-- TO_STRING
-------------------------------------------------------------------   
  function justify (
    value     : in STRING;
    justified : in SIDE  := right;
    field     : in width := 0)
    return STRING is
    constant VAL_LEN : INTEGER             := value'length;
    variable result  : STRING (1 to field) := (others => ' ');
  begin  -- function justify
    -- return value if field is too small
    if VAL_LEN >= field then
      return value;
    end if;
    if justified = left then
      result(1 to VAL_LEN) := value;
    elsif justified = right then
      result(field - VAL_LEN + 1 to field) := value;
    end if;
    return result;
  end function justify;

  -----------------------------------------------------------------------------
  -- to_string funcitons for bit_vector
  -----------------------------------------------------------------------------
  function to_string (
    value     : in BIT_VECTOR;
    justified : in SIDE  := right;
    field     : in width := 0
    ) return STRING is
    alias ivalue    : BIT_VECTOR(1 to value'length) is value;
    variable result : STRING(1 to value'length);
  begin
    if value'length < 1 then
      return NUS;
    else
      for i in ivalue'range loop
        if iValue(i) = '0' then
          result(i) := '0';
        else
          result(i) := '1';
        end if;
      end loop;
      return justify(result, justified, field);
    end if;
  end function to_string;

  -- alias to_bstring is to_string [BIT_VECTOR, SIDE, WIDTH return STRING];
  -------------------------------------------------------------------    
  -- TO_HSTRING
  -------------------------------------------------------------------   
  function to_hstring (
    value     : in BIT_VECTOR;
    justified : in SIDE  := right;
    field     : in width := 0
    ) return STRING is
    constant ne     : INTEGER                                    := (value'length+3)/4;
    constant pad    : BIT_VECTOR(0 to (ne*4 - value'length) - 1) := (others => '0');
    variable ivalue : BIT_VECTOR(0 to ne*4 - 1);
    variable result : STRING(1 to ne);
    variable quad   : BIT_VECTOR(0 to 3);
  begin
    if value'length < 1 then
      return NUS;
    end if;
    ivalue := pad & value;
    for i in 0 to ne-1 loop
      quad := ivalue(4*i to 4*i+3);
      case quad is
        when x"0" => result(i+1) := '0';
        when x"1" => result(i+1) := '1';
        when x"2" => result(i+1) := '2';
        when x"3" => result(i+1) := '3';
        when x"4" => result(i+1) := '4';
        when x"5" => result(i+1) := '5';
        when x"6" => result(i+1) := '6';
        when x"7" => result(i+1) := '7';
        when x"8" => result(i+1) := '8';
        when x"9" => result(i+1) := '9';
        when x"A" => result(i+1) := 'A';
        when x"B" => result(i+1) := 'B';
        when x"C" => result(i+1) := 'C';
        when x"D" => result(i+1) := 'D';
        when x"E" => result(i+1) := 'E';
        when x"F" => result(i+1) := 'F';
      end case;
    end loop;
    return justify(result, justified, field);
  end function to_hstring;

  -------------------------------------------------------------------    
  -- TO_OSTRING
  -------------------------------------------------------------------   
  function to_ostring (
    value     : in BIT_VECTOR;
    justified : in SIDE  := right;
    field     : in width := 0
    ) return STRING is
    constant ne     : INTEGER                                    := (value'length+2)/3;
    constant pad    : BIT_VECTOR(0 to (ne*3 - value'length) - 1) := (others => '0');
    variable ivalue : BIT_VECTOR(0 to ne*3 - 1);
    variable result : STRING(1 to ne);
    variable tri    : BIT_VECTOR(0 to 2);
  begin
    if value'length < 1 then
      return NUS;
    end if;
    ivalue := pad & value;
    for i in 0 to ne-1 loop
      tri := ivalue(3*i to 3*i+2);
      case tri is
        when o"0" => result(i+1) := '0';
        when o"1" => result(i+1) := '1';
        when o"2" => result(i+1) := '2';
        when o"3" => result(i+1) := '3';
        when o"4" => result(i+1) := '4';
        when o"5" => result(i+1) := '5';
        when o"6" => result(i+1) := '6';
        when o"7" => result(i+1) := '7';
      end case;
    end loop;
    return justify(result, justified, field);
  end function to_ostring;

  -----------------------------------------------------------------------------
  -- To_string for integer, real, boolean, etc.
  -----------------------------------------------------------------------------
  function to_string (
    VALUE     : in INTEGER;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify (value     => INTEGER'image(VALUE),
                    justified => JUSTIFIED,
                    field     => FIELD);
  end function to_string;

  function to_string (
    VALUE     : in BIT;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
    variable result : STRING(1 to 1);
  begin
    if (value = '0') then
      result := "0";
    else
      result := "1";
    end if;
    return justify(value     => result,
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;

  function to_string (
    VALUE     : in BOOLEAN;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify(value     => BOOLEAN'image(VALUE),
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;

  function to_string (
    VALUE     : in SEVERITY_LEVEL;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify(value     => SEVERITY_LEVEL'image(VALUE),
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;
  
  function to_string (
    VALUE     : in FILE_OPEN_KIND;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify(value     => FILE_OPEN_KIND'image(VALUE),
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;
  
  function to_string (
    VALUE     : in FILE_OPEN_STATUS;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify(value     => FILE_OPEN_STATUS'image(VALUE),
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;

  function to_string (
    VALUE     : in SIDE;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
  begin
    return justify(value     => SIDE'image(VALUE),
                   justified => JUSTIFIED,
                   field     => FIELD);
  end function to_string;

  function to_string (
    VALUE     : in REAL;
    JUSTIFIED : in SIDE    := right;
    FIELD     : in WIDTH   := 0;
    DIGITS    : in NATURAL := 0
    ) return STRING is
  begin
    if (DIGITS /= 0) then
      return justify (value => to_string (VALUE, "%1."
                                          & integer'image(DIGITS)
                                          & "f"),
                      JUSTIFIED => JUSTIFIED,
                      FIELD     => FIELD);
    else
      return justify (value     => REAL'image(VALUE),
                      JUSTIFIED => JUSTIFIED,
                      FIELD     => FIELD);
    end if;
  end function to_string;

  -- %%% Remove this funciton (will be implicit in vhdl 200x
  function maximum (l, r : integer)
    return integer is
  begin  -- function maximum
    if L > R then return L;
    else return R;
    end if;
  end function maximum;
  
  function to_string (
    VALUE  : in REAL;
--    JUSTIFIED : SIDE   := right;
--    FIELD     : WIDTH  := 0;
    format : in STRING                  -- %f6.2
    ) return STRING is
    constant czero      : CHARACTER := '0';   -- zero
    constant half       : REAL      := 0.4999999999;  -- almost 0.5
    -- Log10 funciton
    function log10 (arg : real) return integer is
      variable i : integer := 1;
    begin
      if ((arg = 0.0)) then
        return 0;
      elsif arg >= 1.0 then
        while arg >= 10.0**i loop
          i := i + 1;
        end loop;
        return (i-1);
      else
        while arg < 10.0**i loop
          i := i - 1;
        end loop;
        return i;
      end if;
    end function log10;
    -- purpose: writes a fractional real number into a line
    procedure writefrc (
      variable L         : inout LINE;  -- LINE
      variable cdes      : in    CHARACTER;
      variable precision : in    INTEGER;     -- number of decimal places
      variable value     : in    REAL) is     -- real value
      variable rvar  : REAL;            -- temp variable
      variable xint  : INTEGER;
      variable xreal : REAL;
    begin
      xreal := (10.0**(-precision));
      write (L, '.');
      rvar  := value;
      for i in 1 to precision loop
        rvar  := rvar * 10.0;
        xint  := integer(rvar-0.49999999999);         -- round
        write (L, xint);
        rvar  := rvar - real(xint);
        xreal := xreal * 10.0;
        if (cdes = 'g') and (rvar < xreal) then
          exit;
        end if;
      end loop;
    end procedure writefrc;
    -- purpose: replace the "." with a "@", and "e" with "j" to get around
    -- read ("6.") and read ("2e") issues.
    function subdot (
      constant format : STRING)
      return STRING is
      variable result : STRING (format'range);
    begin
      for i in format'range loop
        if (format(i) = '.') then
          result(i) := '@';             -- Because the parser reads 6.2 as REAL
        elsif (format(i) = 'e') then
          result(i) := 'j';             -- Because the parser read 2e as REAL
        elsif (format(i) = 'E') then
          result(i) := 'J';             -- Because the parser reads 2E as REAL
        else
          result(i) := format(i);
        end if;
      end loop;
      return result;
    end function subdot;
    -- purpose: find a . in a STRING
    function isdot (
      constant format : STRING)
      return BOOLEAN is
    begin
      for i in format'range loop
        if (format(i) = '@') then
          return true;
        end if;
      end loop;
      return false;
    end function isdot;
    variable exp            : INTEGER;  -- integer version of baseexp
    variable bvalue         : REAL;     -- base value
    variable roundvar, tvar : REAL;     -- Rounding values
    variable frcptr         : INTEGER;  -- integer version of number
    variable fwidth, dwidth : INTEGER;  -- field width and decimal width
    variable dash, dot      : BOOLEAN   := false;
    variable cdes, ddes     : CHARACTER := ' ';
    variable L              : LINE;     -- line type
  begin
    -- Perform the same function that "printf" does
    -- examples "%6.2f" "%-7e" "%g"
    if not (format(format'left) = '%') then
      report "to_string: Illegal format string """ & format & '"'
        severity error;
      return "";
    end if;
    L := new string'(subdot(format));
    read (L, ddes);                     -- toss the '%'
    case L.all(1) is
      when '-'                                     => dash := true;
      when '@'                                     => dash := true;  -- in FP, a "-" and a "." are the same
      when 'f'                                     => cdes := 'f';
      when 'F'                                     => cdes := 'F';
      when 'g'                                     => cdes := 'g';
      when 'G'                                     => cdes := 'G';
      when 'j'                                     => cdes := 'e';  -- parser reads 5e as real, thus we sub j
      when 'J'                                     => cdes := 'E';
      when '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' => null;
      when others                                  =>
        report "to_string: Illegal format string """ & format & '"'
          severity error;
        return "";
    end case;
    if (dash or (cdes /= ' ')) then
      read (L, ddes);                   -- toss the next character
    end if;
    if (cdes = ' ') then
      if (isdot(L.all)) then            -- if you see a . two numbers
        read (L, fwidth);               -- read field width
        read (L, ddes);                 -- toss the next character .
        read (L, dwidth);               -- read decimal width       
      else
        read (L, fwidth);               -- read field width
        dwidth := 6;                    -- the default decimal width is 6
      end if;
      read (L, cdes);
      if (cdes = 'j') then
        cdes := 'e';                    -- because 2e reads as "REAL".
      elsif (cdes = 'J') then
        cdes := 'E';
      end if;
    else
      if (cdes = 'E' or cdes = 'e') then
        fwidth := 10;                   -- default for e and E is %10.6e
      else
        fwidth := 0;                    -- default for f and g is %0.6f
      end if;
      dwidth := 6;
    end if;
    deallocate (L);                     -- reclame the pointer L.
--      assert (not debug) report "Format: " & format & " "
--        & INTEGER'image(fwidth) & "." & INTEGER'image(dwidth) & cdes
--        severity note;
    if (not (cdes = 'f' or cdes = 'F' or cdes = 'g' or cdes = 'G'
             or cdes = 'e' or cdes = 'E')) then
      report "to_string: Illegal format """ & format & '"' severity error; 
      return "";
    end if;
    if (VALUE < 0.0) then
      bvalue := -value;
      write (L, '-');
    else
      bvalue := value;
    end if;
    case cdes is
      when 'e' | 'E' =>                 -- 7.000E+01
        exp      := log10(bvalue);
        roundvar := half*(10.0**(exp-dwidth));
        bvalue   := bvalue + roundvar;  -- round
        exp      := log10(bvalue);      -- because we CAN overflow
        bvalue   := bvalue * (10.0**(-exp));  -- result is D.XXXXXX
        frcptr   := integer(bvalue-half);     -- Write a single digit.
        write (L, frcptr);
        bvalue   := bvalue - real(frcptr);
        writefrc (                      -- Write out the fraction
          L         => L,
          cdes      => cdes,
          precision => dwidth,
          value     => bvalue);
        write (L, cdes);                -- e or E
        if (exp < 0) then
          write (L, '-');
        else
          write (L, '+');
        end if;
        exp := abs(exp);
        if (exp < 10) then              -- we need another "0".
          write (L, czero);
        end if;
        write (L, exp);
      when 'f' | 'F' =>                 -- 70.0
        exp      := log10(bvalue);
        roundvar := half*(10.0**(-dwidth));
        bvalue   := bvalue + roundvar;  -- round
        exp      := log10(bvalue);      -- because we CAN overflow
        if (exp < 0) then               -- 0.X case
          write (L, czero);
        else                            -- loop because real'high > integer'high
          while (exp >= 0) loop
            frcptr := integer(bvalue * (10.0**(-exp)) - half);
            write (L, frcptr);
            bvalue := bvalue - (real(frcptr) * (10.0**exp));
            exp    := exp-1;
          end loop;
        end if;
        writefrc (
          L         => L,
          cdes      => cdes,
          precision => dwidth,
          value     => bvalue);
      when 'g' | 'G' =>                 -- 70
        exp      := log10(bvalue);
        roundvar := half*(10.0**(exp-dwidth));        -- small number
        bvalue   := bvalue + roundvar;  -- round
        exp      := log10(bvalue);      -- because we CAN overflow
        frcptr   := integer(bvalue-half);
        tvar     := bvalue-roundvar - real(frcptr);   -- even smaller number
        if (exp < dwidth)
          and (tvar < roundvar and tvar > -roundvar) then
--            and ((bvalue-roundvar) = real(frcptr)) then
          write (L, frcptr);            -- Just a short integer, write it.
        elsif (exp >= dwidth) or (exp < -4) then
          -- in "e" format (modified)
          bvalue := bvalue * (10.0**(-exp));  -- result is D.XXXXXX
          frcptr := integer(bvalue-half);
          write (L, frcptr);
          bvalue := bvalue - real(frcptr);
          if (bvalue > (10.0**(1-dwidth))) then
            dwidth := dwidth - 1;
            writefrc (
              L         => L,
              cdes      => cdes,
              precision => dwidth,
              value     => bvalue);              
          end if;
          if (cdes = 'G') then
            write (L, 'E');
          else
            write (L, 'e');
          end if;
          if (exp < 0) then
            write (L, '-');
          else
            write (L, '+');
          end if;
          exp := abs(exp);
          if (exp < 10) then
            write (L, czero);
          end if;
          write (L, exp);
        else
          -- in "f" format (modified)
          if (exp < 0) then
            write (L, czero);
            dwidth   := maximum (dwidth, 4);  -- if exp < -4 or > precision.
            bvalue   := bvalue - roundvar;    -- recalculate rounding
            roundvar := half*(10.0**(-dwidth));
            bvalue   := bvalue + roundvar;
          else
            write (L, frcptr);          -- integer part (always small)
            bvalue := bvalue - (real(frcptr));
            dwidth := dwidth - exp - 1;
          end if;
          if (bvalue > roundvar) then
            writefrc (
              L         => L,
              cdes      => cdes,
              precision => dwidth,
              value     => bvalue);
          end if;
        end if;
      when others => return "";
    end case;
    -- You don't truncate real numbers.
--      if (dot) then                 -- truncate
--        if (L.all'length > fwidth) then
--          return justify (value => L.all (1 to fwidth),
--                          justified => RIGHT,
--                          field => fwidth);         
--        else
--          return justify (value => L.all,
--                          justified => RIGHT,
--                          field => fwidth); 
--        end if;
    if (dash) then                      -- fill to fwidth
      return justify (value     => L.all,
                      justified => LEFT,
                      field     => fwidth);
    else
      return justify (value     => L.all,
                      justified => RIGHT,
                      field     => fwidth);
    end if;
  end function to_string;

  -- if the time is 1 ns, and the unit is 1 ps,
  -- then to_string(now) = 1000.0 ps;
  function to_string (
    VALUE     : in TIME;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0;
    UNIT      : in TIME  := ns
    ) return STRING is
    variable L : LINE;                  -- pointer
  begin
    deallocate (L);
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD,
           UNIT      => UNIT);
    return L.all;
  end function to_string;

  -- vector versions
  function to_string (
    VALUE     : in BOOLEAN_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
    variable L : LINE;
  begin
    deallocate (L);
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
    return L.all;
  end function to_string;
  function to_string (
    VALUE     : in INTEGER_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0
    ) return STRING is
    variable L : LINE;
  begin
    deallocate (L);
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
    return L.all;
  end function to_string;
  function to_string (
    VALUE     : in REAL_VECTOR;
    JUSTIFIED : in SIDE    := right;
    FIELD     : in WIDTH   := 0;
    DIGITS    : in NATURAL := 0
    ) return STRING is
    variable L : LINE;
  begin
    deallocate (L);
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD,
           DIGITS    => DIGITS);
    return L.all;
  end function to_string;
  function to_string (
    VALUE  : in REAL_VECTOR;
    format : in STRING
    ) return STRING is
    variable L : LINE;
  begin
    deallocate (L);
    for i in VALUE'range loop
      write (L      => L,
             VALUE  => to_string (VALUE => VALUE(i),
             format => format));
      if (i /= VALUE'right) then
        SWRITE (L     => L,
                VALUE => ", ");
      end if;
    end loop;
    return L.all;
  end function to_string;
  function to_string (
    VALUE     : in TIME_VECTOR;
    JUSTIFIED : in SIDE  := right;
    FIELD     : in WIDTH := 0;
    UNIT      : in TIME  := ns
    ) return STRING is
    variable L : LINE;
  begin
    deallocate (L);
    write (L         => L,
           VALUE     => VALUE,
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD,
           UNIT      => UNIT);
    return L.all;
  end function to_string;

  -- pragma synthesis_on
  -- Will be implicit
  function minimum (L, R : SIDE) return SIDE is
  begin
    if L > R then return R;
    else return L;
    end if;
  end function minimum;
  function maximum (L, R : SIDE) return SIDE is
  begin
    if L > R then return L;
    else return R;
    end if;
  end function maximum;

end package body standard_textio_additions;
