First import from sources

1 files changed, 1320 insertions, 0 deletions

diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl
new file mode 100644
index 0000000..0362ef6
--- /dev/null
+++ b/libraries/std/textio_body.vhdl
@@ -0,0 +1,1320 @@
+--  Std.Textio package body.  This file is part of GHDL.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body textio is
+  -- output routines for standard types
+
+  --  TIME_NAMES associates time units with textual names.
+  --  Textual names are in lower cases, since according to LRM93 14.3:
+  --   when written, the identifier is expressed in lowercase characters.
+  --  The length of the names are 3 characters, the last one may be a space
+  --  for 2 characters long names.
+  type time_unit is
+    record
+      val : time;
+      name : string (1 to 3);
+    end record;
+  type time_names_type is array (1 to 8) of time_unit;
+  constant time_names : time_names_type :=
+    ((fs, "fs "), (ps, "ps "), (ns, "ns "), (us, "us "),
+     (ms, "ms "), (sec, "sec"), (min, "min"), (hr, "hr "));
+
+  --  Non breaking space character.                     --V93
+  constant nbsp : character := character'val (160);	--V93
+
+  procedure writeline (f: out text; l: inout line) is --V87
+  procedure writeline (file f: text; l: inout line) is --V93
+  begin
+    if l = null then
+      -- LRM93 14.3
+      -- If parameter L contains a null access value at the start of the call,
+      -- the a null string is written to the file.
+      write (f, "");
+    else
+      -- LRM93 14.3
+      -- Procedure WRITELINE causes the current line designated by parameter L
+      -- to be written to the file and returns with the value of parameter L
+      -- designating a null string.
+      write (f, l.all);
+      deallocate (l);
+      l := new string'("");
+    end if;
+  end writeline;
+
+  procedure write
+    (l: inout line; value: in string;
+    justified: in side := right; field: in width := 0)
+  is
+    variable length: natural;
+    variable nl: line;
+  begin
+    -- l can be null.
+    if l = null then
+      length := 0;
+    else
+      length := l.all'length;
+    end if;
+    if value'length < field then
+      nl := new string (1 to length + field);
+      if length /= 0 then
+        nl (1 to length) := l.all;
+      end if;
+      if justified = right then
+        nl (length + 1 to length + field - value'length) := (others => ' ');
+        nl (nl.all'high - value'length + 1 to nl.all'high) := value;
+      else
+        nl (length + 1 to length + value'length) := value;
+        nl (length + value'length + 1 to nl.all'high) := (others => ' ');
+      end if;
+    else
+      nl := new string (1 to length + value'length);
+      if length /= 0 then
+        nl (1 to length) := l.all;
+      end if;
+      nl (length + 1 to nl.all'high) := value;
+    end if;
+    deallocate (l);
+    l := nl;
+  end write;
+
+  procedure write
+    (l: inout line; value: in integer;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str: string (11 downto 1);
+    variable val: integer := value;
+    variable digit: natural;
+    variable index: natural := 0;
+  begin
+    --  Note: the absolute value of VAL cannot be directly taken, since
+    --  it may be greather that the maximum value of an INTEGER.
+    loop
+      --  LRM93 7.2.6
+      --  (A rem B) has the sign of A and an absolute value less then
+      --   the absoulte value of B.
+      digit := abs (val rem 10);
+      val := val / 10;
+      index := index + 1;
+      str (index) := character'val(48 + digit);
+      exit when val = 0;
+    end loop;
+    if value < 0 then
+      index := index + 1;
+      str(index) := '-';
+    end if;
+    write (l, str (index downto 1), justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value: in boolean;
+    justified: in side := right; field: in width := 0)
+  is
+  begin
+    if value then
+      write (l, string'("TRUE"), justified, field);
+    else
+      write (l, string'("FALSE"), justified, field);
+    end if;
+  end write;
+
+  procedure write
+    (l: inout line; value: in character;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str: string (1 to 1);
+  begin
+    str (1) := value;
+    write (l, str, justified, field);
+  end write;
+
+  function bit_to_char (value : in bit) return character is
+  begin
+    case value is
+      when '0' =>
+        return '0';
+      when '1' =>
+        return '1';
+    end case;
+  end bit_to_char;
+
+  procedure write
+    (l: inout line; value: in bit;
+    justified: in side := right; field: in width := 0)
+  is
+    variable str : string (1 to 1);
+  begin
+    str (1) := bit_to_char (value);
+    write (l, str, justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value: in bit_vector;
+    justified: in side := right; field: in width := 0)
+  is
+    constant length : natural := value'length;
+    alias n_value : bit_vector (1 to value'length) is value;
+    variable str : string (1 to length);
+  begin
+    for i in str'range loop
+      str (i) := bit_to_char (n_value (i));
+    end loop;
+    write (l, str, justified, field);
+  end write;
+
+  procedure write
+    (l: inout line; value : in time;
+    justified: in side := right; field: in width := 0; unit : in TIME := ns)
+  is
+    --  Copy of VALUE on which we are working.
+    variable val : time := value;
+
+    --  Copy of UNIT on which we are working.
+    variable un : time := unit;
+
+    --  Digit extract from VAL/UN.
+    variable d : integer; -- natural range 0 to 9;
+
+    --  Index for unit name.
+    variable n : integer;
+
+    --  Result.
+    variable str : string (1 to 28);
+
+    --  Current character in RES.
+    variable pos : natural := 1;
+
+    --  Add a character to STR.
+    procedure add_char (c : character) is
+    begin
+      str (pos) := c;
+      pos := pos + 1;
+    end add_char;
+  begin
+    --  Note:
+    --  Care is taken to avoid overflow.  Time may be 64 bits while integer
+    --   may be only 32 bits.
+
+    --  Handle sign.
+    --  Note: VAL cannot be negated since its range may be not symetric
+    --  around 0.
+    if val < 0 ns then
+      add_char ('-');
+    end if;
+
+    --  Search for the first digit.
+    --  Note: we must start from unit, since all units are not a power of 10.
+    --  Note: UN can be multiplied only after we know it is possible.  This
+    --   is a to avoid overflow.
+    if un <= 0 fs then
+      assert false report "UNIT argument is not positive" severity error;
+      un := 1 ns;
+    end if;
+    while val / 10 >= un or val / 10 <= -un loop
+      un := un * 10;
+    end loop;
+
+    --  Extract digits one per one.
+    loop
+      d := val / un;
+      add_char (character'val (abs d + character'pos ('0')));
+      val := val - d * un;
+      exit when val = 0 ns and un <= unit;
+      if un = unit then
+	add_char ('.');
+      end if;
+      --  Stop as soon as precision will be lost.
+      --  This can happen only for hr and min.
+      --  FIXME: change the algorithm to display all the digits.
+      exit when (un / 10) * 10 /= un;
+      un := un / 10;
+    end loop;
+
+    add_char (' ');
+
+    --  Search the time unit name in the time table.
+    n := 0;
+    for i in time_names'range loop
+      if time_names (i).val = unit then
+	n := i;
+	exit;
+      end if;
+    end loop;
+    assert n /= 0 report "UNIT argument is not a unit name" severity error;
+    if n = 0 then
+      add_char ('?');
+    else
+      add_char (time_names (n).name (1));
+      add_char (time_names (n).name (2));
+      if time_names (n).name (3) /= ' ' then
+	add_char (time_names (n).name (3));
+      end if;
+    end if;
+
+    --  Write the result.
+    write (l, str (1 to pos - 1), justified, field);
+  end write;
+
+  -- Parameter DIGITS specifies how many digits to the right of the decimal
+  -- point are to be output when writing a real number; the default value 0
+  -- indicates that the number should be output in standard form, consisting
+  -- of a normalized mantissa plus exponent (e.g., 1.079236E23). If DIGITS is
+  -- nonzero, then the real number is output as an integer part followed by
+  -- '.' followed by the fractional part, using the specified number of digits
+  -- (e.g., 3.14159).
+  -- Note: Nan, +Inf, -Inf are not to be considered, since these numbers are
+  --  not in the bounds defined by any real range.
+  procedure write (L: inout line; value: in real;
+                   justified: in side := right; field: in width := 0;
+		   digits: in natural := 0)
+  is
+    --  STR contains the result of the conversion.
+    variable str : string (1 to 320);
+
+    --  POS is the index of the next character to be put in STR.
+    variable pos : positive := str'left;
+
+    --  VAL contains the value to be converted.
+    variable val : real;
+
+    --  The exponent or mantissa computed is stored in MANTISSA.  This is
+    --  a signed number.
+    variable mantissa : integer;
+
+    variable b : boolean;
+    variable d : natural;
+
+    --  Append character C in STR.
+    procedure add_char (c : character) is
+    begin
+      str (pos) := c;
+      pos := pos + 1;
+    end add_char;
+
+    --  Add digit V in STR.
+    procedure add_digit (v : natural) is
+    begin
+      add_char (character'val (character'pos ('0') + v));
+    end add_digit;
+
+    --  Add leading digit and substract it.
+    procedure extract_leading_digit is
+      variable d : natural range 0 to 10;
+    begin
+      --  Note: We need truncation but type conversion does rounding.
+      --  FIXME: should consider precision.
+      d := natural (val);
+      if real (d) > val then
+	d := d - 1;
+      end if;
+
+      val := (val - real (d)) * 10.0;
+
+      add_digit (d);
+    end extract_leading_digit;
+  begin
+    --  Handle sign.
+    --  There is no overflow here, since with IEEE implementations, sign is
+    --  independant of the mantissa.
+    --  LRM93 14.3
+    --  The sign is never written if the value is non-negative.
+    if value < 0.0 then
+      add_char ('-');
+      val := -value;
+    else
+      val := value;
+    end if;
+
+    --  Compute the mantissa.
+    --  FIXME: should do a dichotomy.
+    if val = 0.0 then
+      mantissa := 0;
+    elsif val < 1.0 then
+      mantissa := -1;
+      while val * (10.0 ** (-mantissa)) < 1.0 loop
+	mantissa := mantissa - 1;
+      end loop;
+    else
+      mantissa := 0;
+      while val / (10.0 ** mantissa) >= 10.0 loop
+	mantissa := mantissa + 1;
+      end loop;
+    end if;
+
+    --  Normalize VAL: in [0; 10[
+    if mantissa >= 0 then
+      val := val / (10.0 ** mantissa);
+    else
+      val := val * 10.0 ** (-mantissa);
+    end if;
+
+    if digits = 0 then
+      for i in 0 to 15 loop
+	extract_leading_digit;
+
+	if i = 0 then
+	  add_char ('.');
+	end if;
+	exit when i > 0 and val < 10.0 ** (i + 1 - 15);
+      end loop;
+
+      --  LRM93 14.3
+      --  if the exponent is present, the `e' is written as a lower case 
+      --  character.
+      add_char ('e');
+
+      if mantissa < 0 then
+	add_char ('-');
+	mantissa := -mantissa;
+      end if;
+      b := false;
+      for i in 4 downto 0 loop
+	d := (mantissa / 10000) mod 10;
+	if d /= 0 or b or i = 0 then
+	  add_digit (d);
+	  b := true;
+	end if;
+	mantissa := (mantissa - d * 10000) * 10;
+      end loop;
+    else
+      if mantissa < 0 then
+	add_char ('0');
+	mantissa := mantissa + 1;
+      else
+	loop
+	  extract_leading_digit;
+	  exit when mantissa = 0;
+	  mantissa := mantissa - 1;
+	end loop;
+      end if;
+      add_char ('.');
+      for i in 1 to digits loop
+	if mantissa = 0 then
+	  extract_leading_digit;
+	else
+	  add_char ('0');
+	  mantissa := mantissa + 1;
+	end if;
+      end loop;
+    end if;
+    write (l, str (1 to pos - 1), justified, field);
+  end write;
+
+  procedure untruncated_text_read                              --V87
+    (variable f : text; str : out string; len : out natural);  --V87
+  procedure untruncated_text_read                              --V93
+    (file f : text; str : out string; len : out natural);      --V93
+
+  attribute foreign : string;                                  --V87
+  attribute foreign of untruncated_text_read : procedure is "GHDL intrinsic";
+
+  procedure untruncated_text_read
+    (variable f : text; str : out string; len : out natural) is    --V87
+    (file f : text; str : out string; len : out natural) is    --V93
+  begin
+    assert false report "must not be called" severity failure;
+  end untruncated_text_read;
+  
+  procedure readline (variable f: in text; l: inout line) --V87
+  procedure readline (file f: text; l: inout line) --V93
+  is
+    variable len, nlen, posn : natural;
+    variable nl, old_l : line;
+    variable str : string (1 to 128);
+    variable is_eol : boolean;
+  begin
+    --  LRM93 14.3
+    --  If parameter L contains a non-null access value at the start of the
+    --  call, the object designated by that value is deallocated before the
+    --  new object is created.
+    if l /= null then
+      deallocate (l);
+    end if;
+    
+    -- We read the input in 128-byte chunks.
+    -- We keep reading until we reach a newline or there is no more input.
+    -- The loop invariant is that old_l is allocated and contains the
+    -- previous chunks read, and posn = old_l.all'length.
+    posn := 0;
+    loop
+      untruncated_text_read (f, str, len);
+      exit when len = 0;
+      if str (len) = LF then
+        --  LRM 14.3
+        --  The representation of the line does not contain the representation
+        --  of the end of the line.
+        is_eol := true;
+        len := len - 1;
+      else
+        is_eol := false;
+      end if;        
+      l := new string (1 to posn + len);
+      if old_l /= null then
+        l (1 to posn) := old_l (1 to posn);
+        deallocate (old_l);
+      end if;
+      l (posn + 1 to posn + len) := str (1 to len);
+      exit when is_eol;
+      posn := posn + len;
+      old_l := l;
+    end loop;
+  end readline;
+
+  --  Replaces L with L (LEFT to/downto L'RIGHT)
+  procedure trim (l : inout line; left : natural)
+  is
+    variable nl : line;
+  begin
+    if l = null then
+      return;
+    end if;
+    if l'left < l'right then
+      --  Ascending.
+      if left > l'right then
+	nl := new string'("");
+      else
+	nl := new string (left to l'right);
+--      nl := new string (1 to l'right + 1 - left);
+	nl.all := l (left to l'right);
+      end if;
+    else
+      --  Descending
+      if left < l'right then
+	nl := new string'("");
+      else
+	nl := new string (left downto l'right);
+--      nl := new string (left - l'right + 1 downto 1);
+	nl.all := l (left downto l'right);
+      end if;
+    end if;
+    deallocate (l);
+    l := nl;
+  end trim;
+
+  --  Replaces L with L (LEFT + 1 to L'RIGHT or LEFT - 1 downto L'RIGHT)
+  procedure trim_next (l : inout line; left : natural)
+  is
+    variable nl : line;
+  begin
+    if l = null then
+      return;
+    end if;
+    if l'left < l'right then
+      --  Ascending.
+      trim (l, left + 1);
+    else
+      --  Descending
+      trim (l, left - 1);
+    end if;
+  end trim_next;
+
+  function to_lower (c : character) return character is
+  begin
+    if c >= 'A' and c <= 'Z' then
+      return character'val (character'pos (c) + 32);
+    else
+      return c;
+    end if;
+  end to_lower;
+
+  procedure read (l: inout line; value: out character; good: out boolean)
+  is
+    variable nl : line;
+  begin
+    if l'length = 0 then
+      good := false;
+    else
+      value := l (l'left);
+      trim_next (l, l'left);
+      good := true;
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out character)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "character read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out bit; good: out boolean)
+  is
+  begin
+    good := false;
+    for i in l'range loop
+      case l(i) is
+	when ' ' 
+	  | NBSP --V93
+	  | HT =>
+	  null;
+	when '1' =>
+	  value := '1';
+	  good := true;
+	  trim_next (l, i);
+	  return;
+	when '0' =>
+	  value := '0';
+	  good := true;
+	  trim_next (l, i);
+	  return;
+	when others =>
+	  return;
+      end case;
+    end loop;
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out bit)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "bit read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out bit_vector; good: out boolean)
+  is
+    --  Number of bit to parse.
+    variable len : natural;
+
+    variable pos, last : natural;
+    variable res : bit_vector (1 to value'length);
+
+    --  State of the previous byte:
+    --  LEADING: blank before the bit vector.
+    --  FOUND: bit of the vector.
+    type state_type is (leading, found);
+    variable state : state_type;
+  begin
+    --  Initialization.
+    len := value'length;
+    if len = 0 then
+      --  If VALUE is a nul array, return now.
+      --  L stay unchanged.
+      --  FIXME: should blanks be removed ?
+      good := true;
+      return;
+    end if;
+    good := false;
+    state := leading;
+    pos := res'left;
+    for i in l'range loop
+      case l(i) is
+	when ' ' 
+	  | NBSP --V93
+	  | HT =>
+	  case state is
+	    when leading =>
+	      null;
+	    when found =>
+	      return;
+	  end case;
+	when '1' | '0' =>
+	  case state is
+	    when leading =>
+	      state := found;
+	    when found =>
+	      null;
+	  end case;
+	  if l(i) = '0' then
+	    res (pos) := '0';
+	  else
+	    res (pos) := '1';
+	  end if;
+	  pos := pos + 1;
+	  len := len - 1;
+	  last := i;
+	  exit when len = 0;
+	when others =>
+	  return;
+      end case;
+    end loop;
+    
+    if len /= 0 then
+      --  Not enough bits.
+      return;
+    end if;
+
+    --  Note: if LEN = 0, then FIRST and LAST have been set.
+    good := true;
+    value := res;
+    trim_next (l, last);
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out bit_vector)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "bit_vector read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out boolean; good: out boolean)
+  is
+    --  State:
+    --  BLANK: space are being scaned.
+    --  L_TF : T(rue) or F(alse) has been scanned.
+    --  L_RA : (t)R(ue) or (f)A(lse) has been scanned.
+    --  L_UL : (tr)U(e) or (fa)L(se) has been scanned.
+    --  L_ES : (tru)E or (fal)S(e) has been scanned.
+    type state_type is (blank, l_tf, l_ra, l_ul, l_es);
+    variable state : state_type;
+    
+    --  Set to TRUE if T has been scanned, to FALSE if F has been scanned.
+    variable res : boolean;
+  begin
+    --  By default, it is a failure.
+    good := false;
+    state := blank;
+    for i in l'range loop
+      case state is
+	when blank =>
+	  if l (i) = ' '
+	    or l (i) = nbsp --V93
+	    or l (i) = HT
+	  then
+	    null;
+	  elsif to_lower (l (i)) = 't' then
+	    res := true;
+	    state := l_tf;
+	  elsif to_lower (l (i)) = 'f' then
+	    res := false;
+	    state := l_tf;
+	  else
+	    return;
+	  end if;
+	when l_tf =>
+	  if res = true and to_lower (l (i)) = 'r' then
+	    state := l_ra;
+	  elsif res = false and to_lower (l (i)) = 'a' then
+	    state := l_ra;
+	  else
+	    return;
+	  end if;
+	when l_ra =>
+	  if res = true and to_lower (l (i)) = 'u' then
+	    state := l_ul;
+	  elsif res = false and to_lower (l (i)) = 'l' then
+	    state := l_ul;
+	  else
+	    return;
+	  end if;
+	when l_ul =>
+	  if res = true and to_lower (l (i)) = 'e' then
+	    trim_next (l, i);
+	    good := true;
+	    value := true;
+	    return;
+	  elsif res = false and to_lower (l (i)) = 's' then
+	    state := l_es;
+	  else
+	    return;
+	  end if;
+	when l_es =>
+	  if res = false and to_lower (l (i)) = 'e' then
+	    trim_next (l, i);
+	    good := true;
+	    value := false;
+	    return;
+	  else
+	    return;
+	  end if;
+      end case;
+    end loop;
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out boolean)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "boolean read failure"
+      severity failure;
+  end read;
+
+  function char_to_nat (c : character) return natural
+  is
+  begin
+    return character'pos (c) - character'pos ('0');
+  end char_to_nat;
+	
+  procedure read (l: inout line; value: out integer; good: out boolean)
+  is
+    variable val : integer;
+    variable d : natural;
+
+    type state_t is (leading, sign, digits);
+    variable cur_state : state_t := leading;
+  begin
+    val := 1;
+    for i in l'range loop
+      case cur_state is
+	when leading =>
+	  case l(i) is
+	    when ' ' 
+	      | NBSP	--V93
+	      | ht =>
+	      null;
+	    when '+' =>
+	      cur_state := sign;
+	    when '-' =>
+	      val := -1;
+	      cur_state := sign;
+	    when '0' to '9' =>
+	      val := char_to_nat (l(i));
+	      cur_state := digits;
+	    when others =>
+	      good := false;
+	      return;
+	  end case;
+	when sign =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val * char_to_nat (l(i));
+	      cur_state := digits;
+	    when others =>
+	      good := false;
+	      return;
+	  end case;
+	when digits =>
+	  case l(i) is
+	    when '0' to '9' =>
+              d := char_to_nat (l(i));
+	      val := val * 10;
+              if val < 0 then
+                val := val - d;
+              else
+                val := val + d;
+              end if;
+	    when others =>
+	      trim (l, i);
+	      good := true;
+	      value := val;
+	      return;
+	  end case;
+      end case;
+    end loop;
+    deallocate (l);
+    l := new string'("");
+    if cur_state /= leading then
+      good := true;
+      value := val;
+    else
+      good := false;
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out integer)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "integer read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out real; good: out boolean)
+  is
+    --  The result.
+    variable val : real;
+    --  True if the result is negative.
+    variable val_neg : boolean;
+
+    --  Number of digits after the dot.
+    variable nbr_dec : natural;
+
+    --  Value of the exponent.
+    variable exp : integer;
+    --  True if the exponent is negative.
+    variable exp_neg : boolean;
+
+    --  The parsing is done with a state machine.
+    --  LEADING: leading blank suppression.
+    --  SIGN: a sign has been found.
+    --  DIGITS: integer parts
+    --  DECIMALS: digits after the dot.
+    --  EXPONENT_SIGN: sign after "E"
+    --  EXPONENT_1: first digit of the exponent.
+    --  EXPONENT: digits of the exponent.
+    type state_t is (leading, sign, digits, decimals,
+		     exponent_sign, exponent_1, exponent);
+    variable cur_state : state_t := leading;
+
+    --  Set VALUE to the result, and set GOOD to TRUE.
+    procedure set_value is
+    begin
+      good := true;
+
+      if exp_neg then
+	val := val * 10.0 ** (-exp);
+      else
+	val := val * 10.0 ** exp;
+      end if;
+      if val_neg then
+	value := -val;
+      else
+	value := val;
+      end if;
+    end set_value;
+
+  begin
+    --  Initialization.
+    val_neg := false;
+    nbr_dec := 1;
+    exp := 0;
+    exp_neg := false;
+
+    --  By default, parsing has failed.
+    good := false;
+
+    --  Iterate over all characters of the string.
+    --  Return immediatly in case of parse error.
+    --  Trim L and call SET_VALUE and return in case of success.
+    for i in l'range loop
+      case cur_state is
+	when leading =>
+	  case l(i) is
+	    when ' '
+	      | NBSP	--V93
+	      | ht =>
+	      null;
+	    when '+' =>
+	      cur_state := sign;
+	    when '-' =>
+	      val_neg := true;
+	      cur_state := sign;
+	    when '0' to '9' =>
+	      val := real (char_to_nat (l(i)));
+	      cur_state := digits;
+	    when others =>
+	      return;
+	  end case;
+	when sign =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := real (char_to_nat (l(i)));
+	      cur_state := digits;
+	    when others =>
+	      return;
+	  end case;
+	when digits =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val * 10.0 + real (char_to_nat (l(i)));
+	    when '.' =>
+	      cur_state := decimals;
+	    when others =>
+	      --  A "." (dot) is required in the string.
+	      return;
+	  end case;
+	when decimals =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      val := val + real (char_to_nat (l(i))) / (10.0 ** nbr_dec);
+	      nbr_dec := nbr_dec + 1;
+	    when 'e' | 'E' =>
+	      --  "nnn.E" is erroneous.
+	      if nbr_dec = 1 then
+		return;
+	      end if;
+	      cur_state := exponent_sign;
+	    when others =>
+	      --  "nnn.XX" is erroneous.
+	      if nbr_dec = 1 then
+		return;
+	      end if;
+	      trim (l, i);
+	      set_value;
+	      return;
+	  end case;
+	when exponent_sign =>
+	  case l(i) is
+	    when '+' =>
+	      cur_state := exponent_1;
+	    when '-' =>
+	      exp_neg := true;
+	      cur_state := exponent_1;
+	    when '0' to '9' =>
+	      exp := char_to_nat (l(i));
+	      cur_state := exponent;
+	    when others =>
+	      --  Error.
+	      return;
+	  end case;
+	when exponent_1 | exponent =>
+	  case l(i) is
+	    when '0' to '9' =>
+	      exp := exp * 10 + char_to_nat (l(i));
+	      cur_state := exponent;
+	    when others =>
+	      trim (l, i);
+	      set_value;
+	      return;
+	  end case;
+      end case;
+    end loop;
+    
+    --  End of string.
+    case cur_state is
+      when leading | sign | digits =>
+	--  Erroneous.
+	return;
+      when decimals =>
+	--  "nnn.XX" is erroneous.
+	if nbr_dec = 1 then
+	  return;
+	end if;
+      when exponent_sign =>
+	--  Erroneous ("NNN.NNNE")
+	return;
+      when exponent_1 =>
+	--  "NNN.NNNE-"
+	return;
+      when exponent =>
+	null;
+    end case;
+
+    deallocate (l);
+    l := new string'("");
+    set_value;
+  end read;
+
+  procedure read (l: inout line; value: out real)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "real read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out time; good: out boolean)
+  is
+    --  The result.
+    variable res : time;
+
+    --  UNIT is computed from the unit name, the exponent and the number of
+    --  digits before the dot.  UNIT is the weight of the current digit.
+    variable unit : time;
+
+    --  Number of digits before the dot.
+    variable nbr_digits : integer;
+
+    --  True if a unit name has been found.  Used temporaly to know the status
+    --  at the end of the search loop.
+    variable unit_found : boolean;
+
+    --  True if the number is negative.
+    variable is_neg : boolean;
+
+    --  Value of the exponent.
+    variable exp : integer;
+
+    --  True if the exponent is negative.
+    variable exp_neg : boolean;
+
+    --  Unit name extracted from the string.
+    variable unit_name : string (1 to 3);
+
+    --  state is the kind of the previous character parsed.
+    --  LEADING: leading blanks
+    --  SIGN: + or - as the first character of the number.
+    --  DIGITS: digit of the integer part of the number.
+    --  DOT: dot (.) after the integer part and before the decimal part.
+    --  DECIMALS: digit of the decimal part.
+    --  EXPONENT_MARK: e or E.
+    --  EXPONENT_SIGN: + or - just after the exponent mark (E).
+    --  EXPONENT: digit of the exponent.
+    --  UNIT_BLANK: blank after the exponent.
+    --  UNIT_1, UNIT_2, UNIT_3: first, second, third character of the unit.
+    type state_type is (leading, sign, digits, dot, decimals,
+			exponent_mark, exponent_sign, exponent,
+			unit_blank, unit_1, unit_2, unit_3);
+    variable state : state_type;
+
+    --  Used during the second scan of the string, TRUE is digits is being
+    --  scaned.
+    variable has_digits : boolean;
+
+    --  Position at the end of the string.
+    variable pos : integer;
+
+    --  Used to compute POS.
+    variable length : integer;
+  begin
+    --  Initialization.
+    --  Fail by default; therefore, in case of error, a return statement is
+    --  ok.
+    good := false;
+    
+    nbr_digits := 0;
+    is_neg := false;
+    exp := 0;
+    exp_neg := false;
+    res := 0 fs;
+
+    --  Look for exponent and unit name.
+    --  Parse the string: this loop checks the correctness of the format, and
+    --  must return (GOOD has been set to FALSE) in case of error.
+    --  Set: NBR_DIGITS, IS_NEG, EXP, EXP_NEG.
+    state := leading;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP  --V93
+	  | HT =>
+	  case state is
+	    when leading | unit_blank =>
+	      null;
+	    when sign | dot | exponent_mark | exponent_sign =>
+	      return;
+	    when digits | decimals | exponent =>
+	      state := unit_blank;
+	    when unit_1 | unit_2 =>
+	      exit;
+	    when unit_3 =>
+	      --  Cannot happen, since an exit is performed at unit_3.
+	      assert false report "internal error" severity failure;
+	  end case;
+	when '+' | '-' =>
+	  case state is
+	    when leading =>
+	      if l(i) = '-' then
+		is_neg := true;
+	      end if;
+	      state := sign;
+	    when exponent_mark =>
+	      if l(i) = '-' then
+		exp_neg := true;
+	      end if;
+	      state := exponent_sign;
+	    when others =>
+	      return;
+	  end case;
+	when '0' to '9' =>
+	  case state is
+	    when exponent_mark | exponent_sign | exponent =>
+	      exp := exp * 10 + char_to_nat (l (i));
+	      state := exponent;
+	    when leading | sign | digits =>
+	      --  Leading "0" are not significant.
+	      if nbr_digits > 0 or l (i) /= '0' then
+		nbr_digits := nbr_digits + 1;
+	      end if;
+	      state := digits;
+	    when decimals =>
+	      null;
+	    when dot =>
+	      state := decimals;
+	    when others =>
+	      return;
+	  end case;
+	when 'a' to 'z' | 'A' to 'Z' =>
+	  case state is
+ 	    when digits | decimals =>
+	      --  "E" has exponent mark.
+	      if l (i) = 'e' or l(i) = 'E' then
+		state := exponent_mark;
+	      else
+		return;
+	      end if;
+	    when unit_blank =>
+	      unit_name (1) := to_lower (l(i));
+	      state := unit_1;
+	    when unit_1 =>
+	      unit_name (2) := to_lower (l(i));
+	      state := unit_2;
+	      pos := i;
+	    when unit_2 =>
+	      unit_name (3) := to_lower (l(i));
+	      state := unit_3;
+	      exit;
+	    when others =>
+	      return;
+	  end case;
+	when '.' =>
+	  case state is
+	    when digits =>
+	      state := decimals;
+	    when others =>
+	      return;
+	  end case;
+	when others =>
+	  return;
+      end case;
+    end loop;
+
+    --  A unit name (2 or 3 letters) must have been found.
+    --  The string may end anywhere.
+    if state /= unit_2 and state /= unit_3 then
+      return;
+    end if;
+
+    --  Compute EXP with the sign.
+    if exp_neg then
+      exp := -exp;
+    end if;
+
+    --  Search the unit name in the list of time names.
+    unit_found := false;
+    for i in time_names'range loop
+      --  The first two characters must match (case insensitive).
+      --  The third character must match if:
+      --  * the unit name is a three characters identifier (ie, not a blank).
+      --  * there is a third character in STR.
+      if time_names (i).name (1) = unit_name (1)
+	and time_names (i).name (2) = unit_name (2)
+	and (time_names (i).name (3) = ' '
+	     or time_names (i).name (3) = unit_name (3))
+      then
+	unit := time_names (i).val;
+	unit_found := true;
+	--  POS is set to the position of the first invalid character.
+	if time_names (i).name (3) = ' ' then
+	  length := 1;
+	else
+	  length := 2;
+	end if;
+	if l'left < l'right then
+	  pos := pos + length;
+	else
+	  pos := pos - length;
+	end if;
+	exit;
+      end if;
+    end loop;
+    if not unit_found then
+      return;
+    end if;
+
+    --  Compute UNIT, the weight of the first non-significant character.
+    nbr_digits := nbr_digits + exp - 1;
+    if nbr_digits < 0 then
+      unit := unit / 10 ** (-nbr_digits);
+    else
+      unit := unit * 10 ** nbr_digits;
+    end if;
+
+    --  HAS_DIGITS will be set as soon as a digit is found.
+    --  No error is expected here (this has been checked during the first
+    --  pass).
+    has_digits := false;
+    for i in l'range loop
+      case l (i) is
+	when ' '
+	  | NBSP  --V93
+	  | HT =>
+	  if has_digits then
+	    exit;
+	  end if;
+	when '+' | '-' =>
+	  if not has_digits then
+	    has_digits := true;
+	  else
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when '0' to '9' =>
+	  --  Leading "0" are not significant.
+	  if l (i) /= '0' or res /= 0 fs then
+	    res := res + char_to_nat (l (i)) * unit;
+	    unit := unit / 10;
+	  end if;
+	  has_digits := true;
+	when 'a' to 'z' | 'A' to 'Z' =>
+	  if has_digits then
+	    exit;
+	  else
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when '.' =>
+	  if not has_digits then
+	    assert false report "internal error" severity failure;
+	    return;
+	  end if;
+	when others =>
+	  assert false report "internal error" severity failure;
+	  return;
+      end case;
+    end loop;
+
+    --  Set VALUE.
+    if is_neg then
+      value := -res;
+    else
+      value := res;
+    end if;
+    good := true;
+    trim (l, pos);
+    return;
+  end read;
+
+  procedure read (l: inout line; value: out time)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "time read failure"
+      severity failure;
+  end read;
+
+  procedure read (l: inout line; value: out string; good: out boolean)
+  is
+    constant len : natural := value'length;
+  begin
+    if l'length < len then
+      good := false;
+      return;
+    end if;
+    good := true;
+    if len = 0 then
+      return;
+    end if;
+    if l'left < l'right then
+      value := l (l'left to l'left + len - 1);
+      trim (l, l'left + len);
+    else
+      value := l (l'left downto l'left - len + 1);
+      trim (l, l'left - len);
+    end if;
+  end read;
+
+  procedure read (l: inout line; value: out string)
+  is
+    variable res : boolean;
+  begin
+    read (l, value, res);
+    assert res = true
+      report "string read failure"
+      severity failure;
+  end read;
+
+end textio;