textio_body.vhdl

vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.

    --  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;