vhdl 2008: add justify and swrite in textio.

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;