diff options
Diffstat (limited to 'ieee_proposed/rtl/standard_textio_additions_c.vhd')
| -rw-r--r-- | ieee_proposed/rtl/standard_textio_additions_c.vhd | 478 |
1 files changed, 478 insertions, 0 deletions
diff --git a/ieee_proposed/rtl/standard_textio_additions_c.vhd b/ieee_proposed/rtl/standard_textio_additions_c.vhd new file mode 100644 index 0000000..35ed5d0 --- /dev/null +++ b/ieee_proposed/rtl/standard_textio_additions_c.vhd @@ -0,0 +1,478 @@ +------------------------------------------------------------------------------ +-- "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: 2007-03-13 14:25:58-04 $ +-- RCS ID: $Id: standard_textio_additions_c.vhdl,v 1.5 2007-03-13 14:25:58-04 l435385 Exp $ +-- +-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) +------------------------------------------------------------------------------ +use std.textio.all; +package standard_textio_additions is + +-- procedure DEALLOCATE (P : inout LINE); + + procedure FLUSH (file F : TEXT); + + function MINIMUM (L, R : SIDE) return SIDE; + function MAXIMUM (L, R : SIDE) return SIDE; + + function TO_STRING (VALUE : SIDE) return STRING; + + function JUSTIFY (VALUE : STRING; JUSTIFIED : SIDE := right; FIELD : WIDTH := 0) return STRING; + + procedure SREAD (L : inout LINE; VALUE : out STRING; STRLEN : out NATURAL); + alias STRING_READ is SREAD [LINE, STRING, NATURAL]; + alias BREAD is READ [LINE, BIT_VECTOR, BOOLEAN]; + alias BREAD is READ [LINE, BIT_VECTOR]; + alias BINARY_READ is READ [LINE, BIT_VECTOR, BOOLEAN]; + alias BINARY_READ is READ [LINE, BIT_VECTOR]; + procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN); + procedure OREAD (L : inout LINE; VALUE : out BIT_VECTOR); + alias OCTAL_READ is OREAD [LINE, BIT_VECTOR, BOOLEAN]; + alias OCTAL_READ is OREAD [LINE, BIT_VECTOR]; + procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN); + procedure HREAD (L : inout LINE; VALUE : out BIT_VECTOR); + alias HEX_READ is HREAD [LINE, BIT_VECTOR, BOOLEAN]; + alias HEX_READ is HREAD [LINE, BIT_VECTOR]; + procedure TEE (file F : TEXT; L : inout LINE); + procedure WRITE (L : inout LINE; VALUE : in REAL; + FORMAT : in STRING); + alias SWRITE is WRITE [LINE, STRING, SIDE, WIDTH]; + alias STRING_WRITE is WRITE [LINE, STRING, SIDE, WIDTH]; + alias BWRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH]; + alias BINARY_WRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH]; + procedure OWRITE (L : inout LINE; VALUE : in BIT_VECTOR; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0); + alias OCTAL_WRITE is OWRITE [LINE, BIT_VECTOR, SIDE, WIDTH]; + procedure HWRITE (L : inout LINE; VALUE : in BIT_VECTOR; + JUSTIFIED : in SIDE := right; FIELD : in WIDTH := 0); + alias HEX_WRITE is HWRITE [LINE, BIT_VECTOR, SIDE, WIDTH]; + +end package standard_textio_additions; + +library ieee_proposed; +use ieee_proposed.standard_additions.all; + +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; L : inout LINE) is + begin + write (OUTPUT, L.all & LF); + writeline(F, L); + end procedure TEE; + + procedure FLUSH (file F: TEXT) is -- Implicit + begin + file_close (F); + end procedure FLUSH; + + -- 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; + + -- 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 => '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 => '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 => '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 => '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 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 WRITE (L: inout LINE; VALUE: in REAL; + FORMAT: in STRING) is + begin + swrite ( L => L, + VALUE => to_string (VALUE, FORMAT)); + end procedure WRITE; + + function justify ( + value : STRING; + justified : SIDE := right; + field : 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; + + function to_string ( + VALUE : SIDE) return STRING is + begin + return SIDE'image(VALUE); + 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; |
