---------------------------------------------------------------------------
-- Package TEXTIO as defined in Chapter 14 of the IEEE Standard VHDL
-- Language Reference Manual (IEEE Std. 1076-1987), as modified
-- by the Issues Screening and Analysis Committee (ISAC), a subcommittee
-- of the VHDL Analysis and Standardization Group (VASG) on
-- 10 November, 1988. See "The Sense of the VASG", October, 1989.
---------------------------------------------------------------------------
-- Version information: %W% %G%
---------------------------------------------------------------------------
package TEXTIO is
type LINE is access string;
type TEXT is file of string;
type SIDE is (right, left);
subtype WIDTH is natural;
-- changed for vhdl92 syntax:
file input : TEXT open read_mode is "STD_INPUT";
file output : TEXT open write_mode is "STD_OUTPUT";
-- changed for vhdl92 syntax (and now a built-in):
procedure READLINE(file f: TEXT; L: out LINE);
procedure READ(L:inout LINE; VALUE: out bit; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out bit);
procedure READ(L:inout LINE; VALUE: out bit_vector; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out bit_vector);
procedure READ(L:inout LINE; VALUE: out BOOLEAN; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out character; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out character);
procedure READ(L:inout LINE; VALUE: out integer; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out integer);
procedure READ(L:inout LINE; VALUE: out real; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out real);
procedure READ(L:inout LINE; VALUE: out string; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out string);
procedure READ(L:inout LINE; VALUE: out time; GOOD : out BOOLEAN);
procedure READ(L:inout LINE; VALUE: out time);
-- changed for vhdl92 syntax (and now a built-in):
procedure WRITELINE(file f : TEXT; L : inout LINE);
procedure WRITE(L : inout LINE; VALUE : in bit;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in bit_vector;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in BOOLEAN;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in character;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in integer;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in real;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0;
DIGITS: in NATURAL := 0);
procedure WRITE(L : inout LINE; VALUE : in string;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0);
procedure WRITE(L : inout LINE; VALUE : in time;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0;
UNIT: in TIME := ns);
-- is implicit built-in:
-- function ENDFILE(file F : TEXT) return boolean;
-- function ENDLINE(variable L : in LINE) return BOOLEAN;
--
-- Function ENDLINE as declared cannot be legal VHDL, and
-- the entire function was deleted from the definition
-- by the Issues Screening and Analysis Committee (ISAC),
-- a subcommittee of the VHDL Analysis and Standardization
-- Group (VASG) on 10 November, 1988. See "The Sense of
-- the VASG", October, 1989, VHDL Issue Number 0032.
end;
--*******************************************************
--** **
--** Copyright (c) Model Technology Incorporated 1991 **
--** All Rights Reserved **
--** **
--*******************************************************
package body TEXTIO is
constant MAX_LINE : integer := 500;
-- Maximum number of characters allowed in an input line
-- by the READLINE routine.
constant MAX_DIGITS : integer := 20;
-- Number of decimal digits which can be processed by the
-- integer input and output routines. Includes leading
-- minus sign, should be large enough for 64-bit integers.
subtype int_string_buf is string(1 to MAX_DIGITS);
-- V-System VHDL will round time values below the base simulation
-- unit to 0 when the model is loaded (more precisely, the
-- internal integer representation of a time value is divided
-- by the integer number of femtoseconds in the base time unit,
-- which results in values less than the base time unit
-- becoming zero). It is possible to determine the simulation
-- time unit by scanning the following list for the first
-- non-zero entry. ns is used in the declaration of all times
-- because textio is not a legal program unless the base time
-- unit is less than or equal to ns (ns is used in the
-- declaration of the version of WRITE which outputs time
-- values!).
type time_unit_enum is
(u_fs, u_ps, u_ns, u_us, u_ms, u_sec, u_min, u_hr);
type time_unit_name_array is array (time_unit_enum) of string(1 to 3);
constant time_unit_names: time_unit_name_array
:= ("fs ", "ps ", "ns ", "us ", "ms ", "sec", "min", "hr ");
type time_array is array (time_unit_enum) of time;
constant find_base_unit: time_array
:= (1.0E-6 ns, -- fs
1.0E-3 ns, -- ps
1 ns,
1 us,
1 ms,
1 sec,
1 min,
1 hr);
procedure Int_to_string(
constant val : in integer;
variable result: out int_string_buf;
variable last: out integer)
is
variable buf : string(MAX_DIGITS downto 1);
variable pos : integer := 1;
variable tmp : integer := abs(val);
variable digit : integer;
begin
loop
digit := abs(tmp MOD 10); -- MOD of integer'left returns neg number!
tmp := tmp / 10;
buf(pos) := character'val(character'pos('0') + digit);
pos := pos + 1;
exit when tmp = 0;
end loop;
if val < 0 then
buf(pos) := '-';
pos := pos + 1;
end if;
pos := pos - 1;
result(1 to pos) := buf(pos downto 1);
last := pos;
end Int_to_string; -- procedure
function Int_to_string(val : integer)
return string
is
variable buf : int_string_buf;
variable last : integer;
begin
Int_to_string(val, buf, last);
return buf(1 to last);
end Int_to_string; -- function
procedure READLINE(file f: TEXT; L: out LINE)
--procedure READLINE(variable f: in TEXT; L : inout LINE)
is
variable buf : string(1 to MAX_LINE);
variable len : integer := 0;
variable c : character;
begin
--if L /= NULL then
-- Deallocate(L);
--end if;
if not Endfile(f) then
READ(f, buf, len);
assert len <= MAX_LINE
report "Textio: Truncated input line greater than "
& Int_to_string(MAX_LINE)
& " characters."
severity ERROR;
end if;
if (len > 0) and (buf(len) = LF) then
len := len - 1;
end if;
L := new string'(buf(1 to len));
end;
procedure Skip_white(variable L : in LINE; pos : inout integer)
is
begin
while pos <= L'high loop
case L(pos) is
when ' ' | HT =>
pos := pos + 1;
when others =>
exit;
end case;
end loop;
end;
procedure Shrink_line(L : inout LINE; pos : in integer)
is
variable old_L : LINE := L;
begin
if pos > 1 then
L := new string'(old_L(pos to old_L'high));
Deallocate(old_L);
end if;
end;
procedure Grow_line(L : inout LINE; incr : in integer)
is
variable old_L : LINE := L;
variable bfp: integer; -- Blank fill pointer.
begin
assert incr > 0
report "Textio: Grow_line called with zero increment."
severity error;
if L = null then
bfp := 0;
L := new string(1 to incr);
else
bfp := old_L'high;
L := new string(old_L'low to old_L'high + incr);
L(old_L'low to old_L'high) := old_L.all;
Deallocate(old_L);
end if;
for i in 1 to incr loop
L(bfp + i) := ' ';
end loop;
end;
procedure Report_results(good : boolean; read_type : string)
is
begin
assert good
report "Could not read type " & read_type & " from line."
severity error;
end;
function lower_case(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;
-- compare two strings ignoring case
function strcmp(a, b : string) return boolean
is
alias a_val : string(1 to a'length) is a;
alias b_val : string(1 to b'length) is b;
variable a_char, b_char : character;
begin
if a'length /= b'length then
return false;
elsif a = b then
return true;
end if;
for i in 1 to a'length loop
a_char := lower_case(a_val(i));
b_char := lower_case(b_val(i));
if a_char /= b_char then
return false;
end if;
end loop;
return true;
end;
procedure Extract_integer(
variable L: inout LINE;
variable pos: inout integer;
variable value: out integer;
variable ok: out boolean)
is
variable sign: integer := 1;
variable rval: integer := 0;
begin
ok := FALSE;
if pos < L'right and (L(pos) = '-' or L(pos) = '+') then
if L(pos) = '-' then
sign := -1;
end if;
pos := pos + 1;
end if;
-- Once the optional leading sign is removed, an integer can
-- contain only the digits '0' through '9' and the '_'
-- (underscore) character. VHDL disallows two successive
-- underscores, and leading or trailing underscores.
if pos <= L'right and L(pos) >= '0' and L(pos) <= '9' then
while pos <= L'right loop
if L(pos) >= '0' and L(pos) <= '9' then
rval := rval * 10
+ character'pos(L(pos)) - character'pos('0');
ok := TRUE;
elsif L(pos) = '_' then
if pos = L'right
or L(pos + 1) < '0'
or L(pos + 1) > '9' then
ok := FALSE;
exit;
end if;
else
exit;
end if;
pos := pos + 1;
end loop;
end if;
value := sign * rval;
end Extract_integer;
procedure Extract_real(
variable L: inout LINE;
variable pos: inout integer;
variable value: out real;
variable ok: inout boolean)
is
variable sign: real := 1.0;
variable rval: real := 0.0;
procedure Apply_mantissa(
variable L: inout LINE;
variable pos: inout integer;
variable rval: inout real;
variable ok: inout boolean)
is
begin
-- this procedure reads numeric characters and the '_' character until
-- encountering a '.' character. It converts these characters into a
-- real number and indicates any problems through the ok parameter.
ok := FALSE;
rval := 0.0;
if pos <= L'right and L(pos) >= '0' and L(pos) <= '9' then
while pos <= L'right and L(pos) /= '.' and L(pos) /= ' ' and L(pos) /= HT loop
if L(pos) >= '0' and L(pos) <= '9' then
rval := rval*10.0 + real(character'pos(L(pos)) - character'pos('0'));
pos := pos+1;
ok := true;
elsif L(pos) = '_' then
if pos+1 <= L'right then
if L(pos+1) >= '0' and L(pos+1) <= '9' then
pos := pos+1;
else
ok := false;
exit;
end if;
else
ok := false;
exit;
end if;
else
ok := false;
exit;
end if;
end loop;
end if;
end;
procedure Apply_fraction(
variable L: inout LINE;
variable pos: inout integer;
variable rval: inout real;
variable ok: inout boolean)
is
variable powerten: real := 0.1;
begin
-- this procedure reads numeric characters and the '_' character from a
-- line variable and converts them into a fractional number. It indicates
-- the status of the conversion throught the ok parameter.
ok := false;
if pos <= L'right then
while pos <= L'right and ((L(pos) >= '0' and L(pos) <= '9') or L(pos) = '_') loop
if L(pos) = '_' then
if pos+1 <= L'right then
if L(pos+1) >= '0' and L(pos+1) <= '9' then
pos := pos+1;
else
ok := false;
exit;
end if;
else
ok := false;
exit;
end if;
else
rval := rval + (real(character'pos(L(pos))-character'pos('0'))*powerten);
powerten := powerten*0.1;
pos := pos+1;
ok := true;
end if;
end loop;
end if;
end;
procedure Apply_exponent(
variable L: inout LINE;
variable pos: inout integer;
variable rval: inout real;
variable ok: inout boolean)
is
variable int_val: integer:=0;
variable sign : integer := 1;
begin
-- this procedure reads in numeric characters and the '_' character and
-- uses them as an exponent for the rval parameter. It indicates the
-- success of the operation through the ok parameter.
ok := false;
if pos <= L'right then
if (L(pos) = '+') then
pos := pos + 1;
elsif (L(pos) = '-') then
sign := -1;
pos := pos + 1;
end if;
while pos <= L'right and ((L(pos) >= '0' and L(pos) <= '9') or L(pos) = '_') loop
if L(pos) >= '_' then
if pos+1 <= L'right then
if L(pos+1) >= '0' and L(pos+1) <= '9' then
pos := pos+1;
else
ok := false;
exit;
end if;
else
ok := false;
exit;
end if;
else
if int_val <= integer'high/10 then
int_val := int_val*10 + (character'pos(L(pos)) - character'pos('0'));
pos := pos+1;
ok := true;
else
assert false report "Overflow in Exponent of real number!" severity failure;
ok := false;
exit;
end if;
end if;
end loop;
if ok then
rval := rval*(10.0**(int_val * sign));
end if;
end if;
end;
begin
ok:= FALSE;
pos := L'left;
Skip_white(L, pos);
if (pos <= L'right) and (L(pos) = '-') then
sign := -1.0;
pos := pos + 1;
end if;
Apply_mantissa(L,pos,rval,ok); -- get number before decimal point
if ok and pos <= L'right and L(pos) = '.' then
pos := pos + 1;
Apply_fraction(L,pos,rval,ok); -- get fraction after decimal (before exponent)
if ok and pos <= L'right and (L(pos) = 'E' or L(pos) = 'e') then
pos := pos + 1;
Apply_exponent(L,pos,rval,ok); -- get fraction
end if;
end if;
if ok then
value := rval * sign;
end if;
end;
-----------------------------------------------------------------
-- Bit reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out bit; GOOD : out BOOLEAN)
is
variable pos : integer;
variable ok : boolean := FALSE;
begin
if L /= NULL then
pos := L'left;
Skip_white(L, pos);
if pos <= L'right then
if L(pos) = '0' then
VALUE := '0';
ok := TRUE;
elsif L(pos) = '1' then
VALUE := '1';
ok := TRUE;
end if;
end if;
end if;
GOOD := ok;
if ok then
Shrink_line(L, pos + 1);
end if;
end;
procedure READ(L:inout LINE; VALUE: out bit)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "BIT");
end;
-----------------------------------------------------------------
-- Bit vector reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out bit_vector; GOOD : out BOOLEAN)
is
alias val : bit_vector(1 to VALUE'length) is VALUE;
variable vpos : integer := 0; -- Index of last valid bit in val.
variable lpos : integer; -- Index of next unused char in L.
begin
if L /= NULL then
lpos := L'left;
Skip_white(L, lpos);
while lpos <= L'right and vpos < VALUE'length loop
if L(lpos) = '0' then
vpos := vpos + 1;
val(vpos) := '0';
elsif L(lpos) = '1' then
vpos := vpos + 1;
val(vpos) := '1';
else
exit; -- Bit values must be '0' or '1'.
end if;
lpos := lpos + 1;
end loop;
end if;
if vpos = VALUE'length then
GOOD := TRUE;
Shrink_line(L, lpos);
else
GOOD := FALSE;
end if;
end;
procedure READ(L:inout LINE; VALUE: out bit_vector)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "BIT_VECTOR");
end;
-----------------------------------------------------------------
-- BOOLEAN reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out BOOLEAN; GOOD : out BOOLEAN)
is
variable pos : integer;
variable len : integer;
variable ok : boolean := FALSE;
begin
if L /= NULL then
pos := L'left;
Skip_white(L, pos);
len := L'right - pos + 1;
if len >= 4 and strcmp(L(pos to pos + 3), "true") then
ok := TRUE;
VALUE := TRUE;
pos := pos + 4;
elsif len >= 5 and strcmp(L(pos to pos + 4), "false") then
ok := TRUE;
VALUE := FALSE;
pos := pos + 5;
end if;
end if;
GOOD := ok;
if ok then
Shrink_line(L, pos);
end if;
end;
procedure READ(L:inout LINE; VALUE: out BOOLEAN)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "BOOLEAN");
end;
-----------------------------------------------------------------
-- CHARACTER reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out character; GOOD : out BOOLEAN)
is
begin
if L /= NULL and L'length > 0 then
GOOD := TRUE;
VALUE := L(L'left);
Shrink_line(L, L'left + 1);
else
GOOD := FALSE;
end if;
end;
procedure READ(L:inout LINE; VALUE: out character)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "CHARACTER");
end;
-----------------------------------------------------------------
-- INTEGER reading
-----------------------------------------------------------------
procedure READ(L: inout LINE; VALUE: out integer; GOOD: out BOOLEAN)
is
variable pos: integer;
variable rval: integer := 0;
variable exp: integer := 0;
variable ok: boolean := FALSE;
begin
if L /= NULL then
pos := L'left;
Skip_white(L, pos);
Extract_integer(L, pos, rval, ok);
if ok
and pos < L'right
and (L(pos) = 'E' or L(pos) = 'e') then
pos := pos + 1;
Extract_integer(L, pos, exp, ok);
if ok then
if exp > 0 then
rval := rval * 10 ** exp;
elsif exp < 0 then
ok := FALSE;
end if;
end if;
end if;
end if;
GOOD := ok;
if ok then
VALUE := rval;
Shrink_line(L, pos);
end if;
end;
procedure READ(L:inout LINE; VALUE: out integer)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "INTEGER");
end;
-----------------------------------------------------------------
-- REAL reading
-----------------------------------------------------------------
procedure READ(L: inout LINE; VALUE: out real; GOOD : out BOOLEAN)
is
variable rval: real;
variable ok : boolean := FALSE;
variable pos : integer;
begin
if L /= NULL then
pos := L'left;
Skip_white(L, pos);
Extract_real(L, pos, rval, ok);
end if;
GOOD := ok;
if ok then
VALUE := rval;
Shrink_line(L, pos);
end if;
end;
procedure READ(L: inout LINE; VALUE: out real)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "REAL");
end;
-----------------------------------------------------------------
-- STRING reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out string; GOOD : out BOOLEAN)
is
alias val : string(1 to VALUE'length) is VALUE;
variable vpos : integer := 0; -- Index of last valid character in val.
variable lpos : integer; -- Index of next unused char in L.
begin
if L /= NULL then
lpos := L'left;
while lpos <= L'right and vpos < VALUE'length loop
vpos := vpos + 1;
val(vpos) := L(lpos);
lpos := lpos + 1;
end loop;
end if;
if vpos = VALUE'length then
GOOD := TRUE;
Shrink_line(L, lpos);
else
GOOD := FALSE;
end if;
end;
procedure READ(L:inout LINE; VALUE: out string)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "STRING");
end;
-----------------------------------------------------------------
-- TIME reading
-----------------------------------------------------------------
procedure READ(L:inout LINE; VALUE: out time; GOOD : out BOOLEAN)
is
variable rval: real;
variable tval: real;
variable ok : boolean := FALSE;
variable pos : integer;
variable len : integer;
begin
if L /= NULL then
pos := L'left;
Skip_white(L, pos);
Extract_real(L, pos, rval, ok);
-- The numeric literal is optional. If it doesn't appear,
-- assume 1.
if not ok then
rval := 1.0;
pos := L'left;
ok := TRUE;
end if;
Skip_white(L, pos);
len := L'right - pos + 1;
if len >= 2 then
if strcmp(L(pos to pos + 1), "fs") then
tval := 1.0e-6;
pos := pos + 2;
elsif strcmp(L(pos to pos + 1), "ps") then
tval := 1.0e-3;
pos := pos + 2;
elsif strcmp(L(pos to pos + 1), "ns") then
tval := 1.0;
pos := pos + 2;
elsif strcmp(L(pos to pos + 1), "us") then
tval := 1.0e3;
pos := pos + 2;
elsif strcmp(L(pos to pos + 1), "ms") then
tval := 1.0e6;
pos := pos + 2;
elsif strcmp(L(pos to pos + 1), "hr") then
tval := 3600.0 * 1.0e9;
pos := pos + 2;
elsif len >= 3 then
if strcmp(L(pos to pos + 2), "sec") then
tval := 1.0e9;
pos := pos + 3;
elsif strcmp(L(pos to pos + 2), "min") then
tval := 60.0 * 1.0e9;
pos := pos + 3;
else
ok := FALSE;
end if;
else
ok := FALSE;
end if;
else
ok := FALSE;
end if;
end if;
GOOD := ok;
if ok then
VALUE := (rval * tval) * 1 ns;
Shrink_line(l, pos);
end if;
end;
procedure READ(L:inout LINE; VALUE: out time)
is
variable GOOD : BOOLEAN;
begin
READ(L, VALUE, GOOD);
Report_results(GOOD, "TIME");
end;
procedure WRITELINE(file f : TEXT; L : inout LINE)
--procedure WRITELINE(f : out TEXT; L : inout LINE)
is
begin
if L /= null then
write(f, L.all & LF);
Deallocate(L);
else
-- Write a blank line
write(f, (1 => LF));
end if;
end;
procedure WRITE(L : inout LINE; VALUE : in bit;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0)
is
variable fw: integer := 1;
variable new_L: LINE;
variable bp: integer;
begin
if L /= null then
bp := L'high + 1;
else bp := 1;
end if;
if FIELD < 1 then
fw := 1;
elsif FIELD > 1 then
fw := FIELD;
if JUSTIFIED = right then
bp := bp + fw - 1;
end if;
end if;
Grow_line(L, fw);
L(bp) := character'val(bit'pos(VALUE) + character'pos('0'));
end;
procedure WRITE(L : inout LINE; VALUE : in bit_vector;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0)
is
variable fw: integer := VALUE'length;
variable bp: integer;
variable offset: integer := 0;
alias normal : bit_vector(0 to value'length - 1) is value;
begin
if L /= null then
bp := L'high + 1;
else bp := 1;
end if;
if FIELD > VALUE'length then
fw := FIELD;
if JUSTIFIED = right then
offset := fw - VALUE'length;
end if;
end if;
Grow_line(L, fw);
for i in normal'range loop
L(bp + i + offset) := character'val(
bit'pos(normal(i)) + character'pos('0'));
end loop;
end;
procedure WRITE(
variable L : inout LINE;
constant VALUE : in BOOLEAN;
constant JUSTIFIED: in SIDE := right;
constant 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;
procedure WRITE(L : inout LINE; VALUE : in character;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0)
is
variable fw: integer := 1;
variable new_L: LINE;
variable bp: integer;
variable highest : integer;
begin
if L = NULL then
highest := 0;
else highest := L'high;
end if;
bp := highest + 1;
if FIELD < 1 then
fw := 1;
elsif FIELD > 1 then
fw := FIELD;
if JUSTIFIED = right then
bp := highest + fw;
end if;
end if;
Grow_line(L, fw);
L(bp) := VALUE;
end;
procedure WRITE(L : inout LINE; VALUE : in integer;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0)
is
variable buf: int_string_buf;
variable last: integer;
begin
Int_to_string(VALUE, buf, last);
WRITE(L, buf(1 to last), JUSTIFIED, FIELD);
end;
procedure WRITE(L : inout LINE; VALUE : in real;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0;
DIGITS: in NATURAL := 0)
is
constant max_useful_digits: integer := 7;
-- Single precision floating point gives almost 7
-- full digits of precision (not the same as the
-- DIGITS parameter) on a 386/387, and the VHDL
-- Language Reference Manual uses 7 in its example of
-- floating point output, so that's what we'll have.
constant scale_to: real := 10.0 ** max_useful_digits;
-- The floating point equivalent to seven useful digits.
constant max_digits_spec: integer := 40;
-- Ignore a digits specification greater than this, since
-- the decimal exponent range is approximately 10 ** 38
-- to 10 ** -38.
variable decimal_scale: integer := max_useful_digits - 1;
-- After scaling, there will be one significant digit
-- to the left of the decimal point, and the
-- decimal_scale will be the correct value for
-- "n.nnnE<exponent>" format printing.
variable scale_factor: real := 1.0;
variable pos_val: real := VALUE;
variable int_buf: int_string_buf;
variable last: integer;
variable buf: string(1 to 2 * max_digits_spec + 2);
variable bufp: integer := buf'low; -- Next available char in buf.
variable cc: integer;
variable i: integer;
variable rh_digits: integer := 0;
variable int_val: integer;
variable dot_position: integer;
begin
if VALUE < 0.0 then
pos_val := - VALUE;
buf(bufp) := '-';
bufp := bufp + 1;
end if;
if pos_val = 0.0 then
int_val := 0;
decimal_scale := 0;
elsif pos_val < scale_to then
while (pos_val * scale_factor * 10.0) < scale_to loop
decimal_scale := decimal_scale - 1;
scale_factor := scale_factor * 10.0;
end loop;
int_val := integer(pos_val * scale_factor);
else
while pos_val / scale_factor > scale_to loop
decimal_scale := decimal_scale + 1;
scale_factor := scale_factor * 10.0;
end loop;
int_val := integer(pos_val / scale_factor);
end if;
Int_to_string(int_val, int_buf, last);
if last - int_buf'low + 1 > max_useful_digits then
last := int_buf'low + max_useful_digits - 1;
end if;
if DIGITS = 0 or DIGITS > max_digits_spec then
buf(bufp) := int_buf(int_buf'low);
buf(bufp + 1) := '.';
bufp := bufp + 2;
cc := last - int_buf'low; -- We've already taken the first one.
if (cc = 0) then
buf(bufp) := '0';
bufp := bufp + 1;
else
buf(bufp to bufp + cc - 1)
:= int_buf(int_buf'low + 1 to int_buf'low + cc);
bufp := bufp + cc;
end if;
-- Remove trailing zeroes (except the just before the
-- decimal point which makes this a real number).
while buf(bufp - 1) = '0' loop bufp := bufp - 1; end loop;
if buf(bufp - 1) = '.' then bufp := bufp + 1; end if;
if decimal_scale /= 0 then
buf(bufp) := 'E';
bufp := bufp + 1;
Int_to_string(decimal_scale, int_buf, last);
cc := last - int_buf'low + 1;
buf(bufp to bufp + cc - 1) := int_buf(int_buf'low to last);
bufp := bufp + cc;
end if;
else
if decimal_scale >= 0 then
-- Add zeroes on the right side.
dot_position := bufp + decimal_scale + 1;
buf(dot_position) := '.';
for i in int_buf'low to last loop
if bufp = dot_position then
bufp := bufp + 1; -- Skip the dot.
end if;
if bufp > dot_position then
if rh_digits < DIGITS then
rh_digits := rh_digits + 1;
else
exit;
end if;
end if;
buf(bufp) := int_buf(i);
bufp := bufp + 1;
end loop;
if bufp <= dot_position then
while bufp < dot_position loop
buf(bufp) := '0';
bufp := bufp + 1;
end loop;
bufp := bufp + 1; -- Skip the dot.
end if;
for i in rh_digits to DIGITS - 1 loop
if rh_digits < DIGITS then
rh_digits := rh_digits + 1;
else
exit;
end if;
buf(bufp) := '0';
bufp := bufp + 1;
end loop;
else
buf(bufp to bufp + 1) := "0.";
bufp := bufp + 2;
i := int_buf'low;
while rh_digits < DIGITS loop
if decimal_scale < -1 then
buf(bufp) := '0';
decimal_scale := decimal_scale + 1;
elsif i <= last then
buf(bufp) := int_buf(i);
i := i + 1;
else
buf(bufp) := '0';
end if;
rh_digits := rh_digits + 1;
bufp := bufp + 1;
end loop;
end if;
end if;
WRITE(L, buf(buf'low to bufp - 1), JUSTIFIED, FIELD);
end;
procedure WRITE(
variable L : inout LINE;
constant VALUE : in string;
constant JUSTIFIED: in SIDE := right;
constant FIELD : in WIDTH := 0)
is
variable bp : integer;
variable fw : WIDTH := VALUE'length;
begin
if VALUE'length > 0 then
if L = null then
bp := 1;
else
bp := L'high + 1;
end if;
if FIELD > VALUE'length then
fw := FIELD;
if JUSTIFIED = right then
bp := bp + fw - VALUE'length;
end if;
end if;
Grow_line(L, fw);
L(bp to bp + VALUE'length - 1) := VALUE;
end if;
end;
procedure WRITE(
L : inout LINE;
VALUE : in time;
JUSTIFIED: in SIDE := right;
FIELD: in WIDTH := 0;
UNIT: in TIME := ns)
is
variable base_time_index: time_unit_enum := u_hr;
variable unit_time_index: time_unit_enum := u_ns;
variable int_buf: int_string_buf;
variable buf: string(1 to MAX_DIGITS + 6);
variable last: integer;
variable i: integer;
variable decimal_shift: integer;
variable is_neg : boolean := (value < 0 ns);
variable val : time := abs(value);
begin
for i in time_unit_enum loop
if find_base_unit(i) /= 0 hr then
if base_time_index = u_hr then
base_time_index := i;
end if;
if UNIT = find_base_unit(i) then
unit_time_index := i;
end if;
end if;
end loop;
assert base_time_index /= u_hr
report "WRITE: find_base_unit failed."
severity error;
if UNIT = 0 hr or unit_time_index < base_time_index then
-- This may not be a strictly conforming IEEE VHDL
-- program, since if a UNIT smaller than the base
-- simulation unit is specified, the program is
-- in error. We'll handle the problem gracefully.
unit_time_index := base_time_index;
end if;
Int_to_string(val / find_base_unit(base_time_index), int_buf, last);
buf(int_buf'range) := int_buf;
if unit_time_index /= base_time_index then
decimal_shift := 3 * (time_unit_enum'pos(unit_time_index)
- time_unit_enum'pos(base_time_index));
if last > decimal_shift then
last := last + 1;
for i in last downto (last - decimal_shift + 1) loop
buf(i) := buf(i - 1);
end loop;
buf(last - decimal_shift) := '.';
else
i := decimal_shift + 2;
buf(i - last + buf'low to i) := buf(buf'low to last);
for i in buf'low to i - last + buf'low - 1 loop
buf(i) := '0';
end loop;
buf(buf'low + 1) := '.';
last := i;
end if;
-- Strip trailing zero's, perhaps even the decimal point!
while buf(last) = '0' loop
last := last - 1;
end loop;
if buf(last) = '.' then
last := last - 1;
end if;
end if;
-- Add the unit identifier and "print it".
buf(last + 1) := ' ';
if time_unit_names(unit_time_index)(3) = ' ' then
buf(last + 2 to last + 3) :=
time_unit_names(unit_time_index)(1 to 2);
last := last + 3;
else
buf(last + 2 to last + 4) :=
time_unit_names(unit_time_index);
last := last + 4;
end if;
if (is_neg) then
WRITE(L, '-' & buf(buf'low to last), JUSTIFIED, FIELD);
else
WRITE(L, buf(buf'low to last), JUSTIFIED, FIELD);
end if;
end;
end;
<div align="center"><br /><script type="text/javascript"><!--
google_ad_client = "pub-7293844627074885";
//468x60, Created at 07. 11. 25
google_ad_slot = "8619794253";
google_ad_width = 468;
google_ad_height = 60;
//--></script>
<script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script><br /> </div>