diff options
| -rw-r--r-- | libraries/Makefile.inc | 5 | ||||
| -rw-r--r-- | libraries/std/textio.vhdl | 55 | ||||
| -rw-r--r-- | libraries/std/textio_body.vhdl | 128 |
3 files changed, 154 insertions, 34 deletions
diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index a7c51a2c7..5d48c4043 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -77,14 +77,15 @@ MENTOR93_BSRCS := $(MENTOR_BSRCS) .PREFIXES: .vhdl .v93 .v87 .v08 %.v93: %.vhdl - sed -e '/--V87/s/^/ --/' < $< > $@ + sed -e '/--V87/s/^/ --/' \ + -e '/--START-V08/,/--END-V08/s/^/--/' < $< > $@ %.v08: %.vhdl sed -e '/--V87/s/^/ --/' < $< > $@ %.v87: %.vhdl sed -e '/--V93/s/^/ --/' -e '/--START-V93/,/--END-V93/s/^/--/' \ - < $< > $@ + -e '/--START-V08/,/--END-V08/s/^/--/' < $< > $@ STD87_DIR:=$(LIB87_DIR)/std IEEE87_DIR:=$(LIB87_DIR)/ieee diff --git a/libraries/std/textio.vhdl b/libraries/std/textio.vhdl index 71b3ca72e..b9d1e4771 100644 --- a/libraries/std/textio.vhdl +++ b/libraries/std/textio.vhdl @@ -1,6 +1,6 @@ -- Std.Textio package declaration. This file is part of GHDL. -- This file was written from the clause 14.3 of the VHDL LRM. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- Copyright (C) 2002 - 2014 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 @@ -17,23 +17,29 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -package textio is +package Textio is -- type definitions for text i/o -- a LINE is a pointer to a string value. - type line is access string; + type Line is access String; -- A file of variable-length ASCII records. -- Note: in order to work correctly, the TEXT file type must be declared in - -- the textio package of library std. Otherwise, a file of string has a + -- the Textio package of library Std. Otherwise, a file of string has a -- non-ASCII format. - type text is file of string; + type text is file of String; type side is (right, left); -- For justifying ouput data within fields. subtype width is natural; -- For specifying widths of output fields. --- standard text files + -- standard text files + + --START-V08 + function Justify (Value: String; + Justified : Side := Right; + Field: Width := 0 ) return String; + --END-V08 file input: text is in "STD_INPUT"; --V87 file output: text is out "STD_OUTPUT"; --V87 @@ -50,7 +56,7 @@ package textio is -- on direction, or left bound). Therefore, even variable of type LINE -- not initialized by READLINE are accepted. Strictly speaking, this is -- not required by LRM, nor prevented. However, other implementations may - -- fail at parsing such strings. + -- fail at parsing such Strings. -- -- Also, in case of error (GOOD is false), this implementation do not -- modify L (as specified by the LRM) nor VALUE. @@ -60,10 +66,10 @@ package textio is -- -- In case of overflow (ie, if the number is out of the bounds of the type), -- the procedure will fail with an execution error. - -- FIXME: this should not occur for a bad string. + -- FIXME: this should not occur for a bad String. 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); procedure read (l: inout line; value: out bit_vector; good: out boolean); procedure read (l: inout line; value: out bit_vector); @@ -72,7 +78,7 @@ package textio is 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 character); procedure read (l: inout line; value: out integer; good: out boolean); procedure read (l: inout line; value: out integer); @@ -80,8 +86,8 @@ package textio is 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 String; good: out boolean); + procedure read (l: inout line; value: out String); -- This implementation requires no space after the unit identifier, -- ie "7.5 nsv" is parsed as 7.5 ns. @@ -89,16 +95,26 @@ package textio is procedure read (l: inout line; value: out time; good: out boolean); procedure read (l: inout line; value: out time); + --START-V08 + 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]; + --END-V08 + -- output routines for standard types procedure writeline (variable f: out text; l: inout line); --V87 procedure writeline (file f: text; l: inout line); --V93 -- This implementation accept any value for all the types. - procedure write + procedure write (l: inout line; value: in bit; justified: in side := right; field: in width := 0); - procedure write + procedure write (l: inout line; value: in bit_vector; justified: in side := right; field: in width := 0); procedure write @@ -114,8 +130,8 @@ package textio is (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; + procedure write + (l: inout line; value: in String; justified: in side := right; field: in width := 0); -- UNIT must be a unit name declared in std.standard. Of course, no rules @@ -127,4 +143,11 @@ package textio is (l: inout line; value : in time; justified: in side := right; field: in width := 0; unit : in TIME := ns); + --START-V08 + 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]; + --END-V08 end textio; diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl index db0e7fe06..847a17ef8 100644 --- a/libraries/std/textio_body.vhdl +++ b/libraries/std/textio_body.vhdl @@ -17,6 +17,40 @@ -- 02111-1307, USA. package body textio is + --START-V08 + -- LRM08 16.4 + -- The JUSTIFY operation formats a string value within a field that is at + -- least at long as required to contain the value. Parameter FIELD + -- specifies the desired field width. Since the actual field width will + -- always be at least large enough to hold the string value, the default + -- value 0 for the FIELD parameter has the effect of causing the string + -- value to be contained in a field of exactly the right widteh (i.e., no + -- additional leading or tailing spaces). Parameter JUSTIFIED specified + -- wether the string value is to be right- or left-justified within the + -- field; the default is right-justified. If the FIELD parameter describes + -- a field width larger than the number of characters in the string value, + -- space characters are used to fill the remaining characters in the field. + -- + -- TG: Note that the bounds of the result are not specified! + function Justify (Value: String; + Justified : Side := Right; + Field: Width := 0 ) return String + is + constant len : Width := Value'Length; + begin + if Field <= Len then + return Value; + else + case Justified is + when Right => + return (1 to Field - Len => ' ') & Value; + when Left => + return Value & (1 to Field - Len => ' '); + end case; + end if; + end Justify; + --END-V08 + -- output routines for standard types -- TIME_NAMES associates time units with textual names. @@ -37,6 +71,18 @@ package body textio is -- Non breaking space character. --V93 constant nbsp : character := character'val (160); --V93 + function is_whitespace (c : character) return Boolean is + begin + case c is + when ' ' + | NBSP --V93 + | HT => + return True; + when others => + return False; + end case; + end is_Whitespace; + procedure writeline (f: out text; l: inout line) is --V87 procedure writeline (file f: text; l: inout line) is --V93 begin @@ -373,7 +419,7 @@ package body textio is end loop; -- LRM93 14.3 - -- if the exponent is present, the `e' is written as a lower case + -- if the exponent is present, the `e' is written as a lower case -- character. add_char ('e'); @@ -428,7 +474,7 @@ package body textio is 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 @@ -444,7 +490,7 @@ package body textio is 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 @@ -467,7 +513,7 @@ package body textio is is_eol := true; else is_eol := false; - end if; + end if; l := new string (1 to posn + len); if old_l /= null then l (1 to posn) := old_l (1 to posn); @@ -566,7 +612,7 @@ package body textio is good := false; for i in l'range loop case l(i) is - when ' ' + when ' ' | NBSP --V93 | HT => null; @@ -625,7 +671,7 @@ package body textio is pos := res'left; for i in l'range loop case l(i) is - when ' ' + when ' ' | NBSP --V93 | HT => case state is @@ -654,7 +700,7 @@ package body textio is return; end case; end loop; - + if len /= 0 then -- Not enough bits. return; @@ -687,7 +733,7 @@ package body textio is -- 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 @@ -697,10 +743,7 @@ package body textio is for i in l'range loop case state is when blank => - if l (i) = ' ' - or l (i) = nbsp --V93 - or l (i) = HT - then + if is_whitespace (l (i)) then null; elsif to_lower (l (i)) = 't' then res := true; @@ -767,7 +810,7 @@ package body textio 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; @@ -781,7 +824,7 @@ package body textio is case cur_state is when leading => case l(i) is - when ' ' + when ' ' | NBSP --V93 | ht => null; @@ -984,7 +1027,7 @@ package body textio is end case; end case; end loop; - + -- End of string. case cur_state is when leading | sign | digits => @@ -1078,7 +1121,7 @@ package body textio is -- Fail by default; therefore, in case of error, a return statement is -- ok. good := false; - + nbr_digits := 0; is_neg := false; exp := 0; @@ -1331,4 +1374,57 @@ package body textio is severity failure; end read; + --START-V08 + procedure Sread (L : inout Line; Value : out String; Strlen : out Natural) + is + constant maxlen : natural := Value'Length; + alias value1 : string (1 to maxlen) is Value; + variable skipping : boolean := True; + variable f, len, nl_left : natural; + variable nl : line; + begin + -- Skip leading spaces. F designates the index of the first non-space + -- character, LEN the length of the extracted string. + len := 0; + for i in l'range loop + if skipping then + if not is_whitespace (l (i)) then + skipping := false; + f := i; + len := 1; + end if; + else + exit when is_whitespace (l (i)); + len := len + 1; + exit when len = maxlen; + end if; + end loop; + + -- Copy string. + if l'ascending then + value1 (1 to len) := l (f to f + len - 1); + else + value1 (1 to len) := l (f downto f - len + 1); + end if; + strlen := len; + + if l'ascending then + if len = 0 then + f := l'right + 1; + end if; + nl_left := f + len; + nl := new string (nl_left to l'right); + nl.all := l (nl_left to l'right); + else + if len = 0 then + f := l'right - 1; + end if; + nl_left := f - len; + nl := new string (nl_left downto l'right); + nl.all := l (nl_left downto l'right); + end if; + deallocate (l); + l := nl; + end sread; + --END-V08 end textio; |