Replace the "strconv" opcode with a pure VHDL implementation

lib/nvc/text_util-body.vhd

@@ -147,6 +147,12 @@ package body text_util is
             or x = CR or x = ' ';
     end function;
 
+    function isdigit (x : in character) return boolean is
+        constant xp : natural := character'pos(x);
+    begin
+        return xp >= 48 and xp <= 57;
+    end function;
+
     function canon_value (s : string) return string is
         constant length  : natural := s'length;
         alias ss         : string(1 to length) is s;
@@ -172,4 +178,221 @@ package body text_util is
         return result(1 to trimmed - 1);
     end function;
 
+    procedure string_to_int (s     : in string;
+                             value : out t_int64;
+                             used  : out natural)
+    is
+        constant length      : natural := s'length;
+        alias ss             : string(1 to length) is s;
+        variable pos         : positive := 1;
+        variable is_negative : boolean;
+        variable result      : t_int64 := 0;
+        variable num_digits  : natural;
+        constant ascii_zero  : natural := character'pos('0');
+        variable ascii_value : natural;
+        variable digit       : natural;
+    begin
+        while pos <= length and isspace(ss(pos)) loop
+            pos := pos + 1;
+        end loop;
+
+        is_negative := pos <= length and ss(pos) = '-';
+        if is_negative then
+            pos := pos + 1;
+        end if;
+
+        while pos <= length and (isdigit(ss(pos)) or ss(pos) = '_') loop
+            if ss(pos) /= '_' then
+                ascii_value := character'pos(ss(pos));
+                digit := ascii_value - ascii_zero;
+                if result >= 0 then
+                    result := (result * 10) + t_int64(digit);
+                else
+                    result := (result * 10) - t_int64(digit);
+                end if;
+                if is_negative and result > 0 then
+                    -- Negate now to avoid problems around INTEGER'LOW
+                    result := -result;
+                    is_negative := false;
+                end if;
+                num_digits := num_digits + 1;
+            end if;
+            pos := pos + 1;
+        end loop;
+
+        assert num_digits > 0
+            report "invalid integer value """ & s & """" severity failure;
+
+        used := pos - 1;
+        value := result;
+    end procedure;
+
+    function string_to_int (s : string) return t_int64 is
+        variable used   : natural;
+        variable value  : t_int64;
+        constant length : natural := s'length;
+        alias ss        : string(1 to length) is s;
+    begin
+        string_to_int(s, value, used);
+
+        for i in used + 1 to length loop
+            assert isspace(ss(i))
+                report ("found invalid characters """ & ss(i to length)
+                        & """ after value """ & s & """") severity failure;
+        end loop;
+
+        return value;
+    end function;
+
+    type t_real_array is array (natural range <>) of real;
+
+    function string_to_real (s : string) return real is
+        -- Derived from strtod implementation in FreeBSD
+        constant length       : natural := s'length;
+        alias ss              : string(1 to length) is s;
+        variable pos          : positive := 1;
+        constant max_exponent : integer := 511;
+        constant powers_of_10 : t_real_array(0 to 8) := (
+            10.0, 100.0, 1.0e4, 1.0e8, 1.0e16, 1.0e32, 1.0e64, 1.0e128, 1.0e256 );
+        variable sign         : boolean;
+        variable exp_sign     : boolean;
+        variable fraction     : real;
+        variable dbl_exp      : real;
+        variable exp          : integer := 0;
+        variable frac_exp     : integer := 0;
+        variable mant_size    : integer := 0;
+        variable dec_pt       : integer := -1;
+        variable char         : character;
+        variable frac1, frac2 : integer;
+        constant ascii_zero   : natural := character'pos('0');
+        variable p_exp        : positive;
+    begin
+        while pos <= length and isspace(ss(pos)) loop
+            pos := pos + 1;
+        end loop;
+
+        if ss(pos) = '-' then
+            sign := true;
+            pos := pos + 1;
+        elsif ss(pos) = '+' then
+            pos := pos + 1;
+        end if;
+
+        -- Count the number of digits in the mantissa and locate the
+        -- decimal point
+        while pos <= length loop
+            char := ss(pos);
+            if not isdigit(char) then
+                if char /= '.' or dec_pt >= 0 then
+                    exit;
+                end if;
+                dec_pt := mant_size;
+            end if;
+            pos := pos + 1;
+            mant_size := mant_size + 1;
+        end loop;
+
+        -- Collect the digits in the mantissa
+        p_exp := pos;
+        pos := pos - mant_size;
+        if dec_pt < 0 then
+            dec_pt := mant_size;
+        else
+            mant_size := mant_size - 1;
+        end if;
+        if mant_size > 18 then
+            frac_exp := dec_pt - 18;
+            mant_size := 18;
+        else
+            frac_exp := dec_pt - mant_size;
+        end if;
+
+        assert mant_size > 0
+            report "zero sized mantissa: " & s severity failure;
+
+        frac1 := 0;
+        while mant_size > 9 loop
+            char := ss(pos);
+            pos := pos + 1;
+            if char = '.' then
+                char := ss(pos);
+                pos := pos + 1;
+            end if;
+            frac1 := 10*frac1 + (character'pos(char) - ascii_zero);
+            mant_size := mant_size - 1;
+        end loop;
+        frac2 := 0;
+        while mant_size > 0 loop
+            char := ss(pos);
+            pos := pos + 1;
+            if char = '.' then
+                char := ss(pos);
+                pos := pos + 1;
+            end if;
+            frac2 := 10*frac2 + (character'pos(char) - ascii_zero);
+            mant_size := mant_size - 1;
+        end loop;
+        fraction := (1.0e9 * real(frac1)) + real(frac2);
+
+        -- Skim off the exponent
+        pos := p_exp;
+        if pos <= length and (ss(pos) = 'E' or ss(pos) = 'e') then
+            pos := pos + 1;
+            if ss(pos) = '-' then
+                exp_sign := true;
+                pos := pos + 1;
+            elsif ss(pos) = '+' then
+                pos := pos + 1;
+            end if;
+            char := ss(pos);
+            while pos <= length and isdigit(char) loop
+                exp := exp * 10 + (character'pos(char) - ascii_zero);
+                pos := pos + 1;
+            end loop;
+        end if;
+
+        if exp_sign then
+            exp := frac_exp - exp;
+        else
+            exp := frac_exp + exp;
+        end if;
+
+        -- Generate a floating-point number that represents the exponent
+        if exp < 0 then
+            exp_sign := true;
+            exp := -exp;
+        else
+            exp_sign := false;
+        end if;
+
+        assert exp <= max_exponent
+            report "exponent too large: " & s severity failure;
+
+        dbl_exp := 1.0;
+        for d in powers_of_10'range loop
+            exit when exp = 0;
+            if (exp rem 2) = 1 then
+                dbl_exp := dbl_exp * powers_of_10(d);
+            end if;
+            exp := exp / 2;
+        end loop;
+
+        if exp_sign then
+            fraction := fraction / dbl_exp;
+        else
+            fraction := fraction * dbl_exp;
+        end if;
+
+        for i in pos to length loop
+            assert isspace(ss(i))
+                report ("found invalid characters """ & ss(i to length)
+                        & """ after value """ & s & """") severity failure;
+        end loop;
+
+        if sign then
+            return -fraction;
+        else
+            return fraction;
+        end if;
+    end function;
 end package body;

lib/nvc/text_util.vhd

@@ -27,16 +27,23 @@ package text_util is
         buf   : str_ptr_t;
     end record;
 
+    type t_int64 is range -9223372036854775807 - 1 to 9223372036854775807;
+
     procedure tb_cat (tb : out text_buf_t; str : in string);
 
-    -- Used in the implementation of 'VALUE for composite types
+    -- Used to implement 'VALUE and 'IMAGE for scalar types
+    function canon_value (s : string) return string;
+    function string_to_int (s : string) return t_int64;
+    procedure string_to_int (s : in string; value : out t_int64;
+                             used : out natural);
+    function string_to_real (s : string) return real;
+
+    -- Used to implement 'VALUE for composite types
     function next_delimiter (s : string; pos : natural) return string;
     function count_delimiters (s : string) return natural;
     function find_open (s : string) return natural;
     function find_quote (s : string) return natural;
     procedure find_close (s : string; pos : natural);
     function find_unquote (s : string; pos : natural) return natural;
     procedure report_bad_char (s : string; c : character);
-
-    function canon_value (s : string) return string;
 end package;

src/jit/jit-dump.c

@@ -71,14 +71,13 @@ const char *jit_exit_name(jit_exit_t exit)
       "REAL_TO_STRING", "RANGE_FAIL", "FUNC_WAIT", "INIT_SIGNAL",
       "DRIVE_SIGNAL", "SCHED_WAVEFORM", "SCHED_PROCESS", "TEST_EVENT",
       "TEST_ACTIVE", "SCHED_EVENT", "FILE_OPEN", "FILE_CLOSE",
-      "FILE_READ", "FILE_WRITE", "ENDFILE", "STRCONVI", "STRCONVR",
-      "DEBUG_OUT", "ALIAS_SIGNAL", "MAP_SIGNAL", "MAP_CONST",
-      "RESOLVE_SIGNAL", "LAST_EVENT", "LAST_ACTIVE", "DISCONNECT",
-      "ELAB_ORDER_FAIL", "FORCE", "RELEASE", "PUSH_SCOPE", "POP_SCOPE",
-      "IMPLICIT_SIGNAL", "DRIVING", "DRIVING_VALUE", "CLAIM_TLAB",
-      "COVER_TOGGLE", "PROCESS_INIT", "CLEAR_EVENT", "IMPLICIT_EVENT",
-      "ENTER_STATE", "REFLECT_VALUE", "REFLECT_SUBTYPE", "FUNCTION_TRIGGER",
-      "ADD_TRIGGER",
+      "FILE_READ", "FILE_WRITE", "ENDFILE", "DEBUG_OUT", "ALIAS_SIGNAL",
+      "MAP_SIGNAL", "MAP_CONST", "RESOLVE_SIGNAL", "LAST_EVENT",
+      "LAST_ACTIVE", "DISCONNECT", "ELAB_ORDER_FAIL", "FORCE", "RELEASE",
+      "PUSH_SCOPE", "POP_SCOPE", "IMPLICIT_SIGNAL", "DRIVING", "DRIVING_VALUE",
+      "CLAIM_TLAB", "COVER_TOGGLE", "PROCESS_INIT", "CLEAR_EVENT",
+      "IMPLICIT_EVENT", "ENTER_STATE", "REFLECT_VALUE", "REFLECT_SUBTYPE",
+      "FUNCTION_TRIGGER", "ADD_TRIGGER",
    };
    assert(exit < ARRAY_LEN(names));
    return names[exit];

src/jit/jit-irgen.c

@@ -3267,34 +3267,6 @@ static void irgen_op_active(jit_irgen_t *g, int op)
    g->map[vcode_get_result(op)] = j_recv(g, 0);
 }
 
-static void irgen_op_strconv(jit_irgen_t *g, int op)
-{
-   jit_value_t ptr = irgen_get_arg(g, op, 0);
-   jit_value_t len = irgen_get_arg(g, op, 1);
-
-   jit_value_t used = jit_null_ptr();
-   if (vcode_count_args(op) > 2)
-      used = irgen_get_arg(g, op, 2);
-
-   j_send(g, 0, ptr);
-   j_send(g, 1, len);
-   j_send(g, 2, used);
-
-   switch (vtype_kind(vcode_get_type(op))) {
-   case VCODE_TYPE_INT:
-      macro_exit(g, JIT_EXIT_STRING_TO_INT);
-      break;
-   case VCODE_TYPE_REAL:
-      macro_exit(g, JIT_EXIT_STRING_TO_REAL);
-      break;
-   default:
-      vcode_dump_with_mark(op, NULL, NULL);
-      fatal_trace("invalid type in strconv");
-   }
-
-   g->map[vcode_get_result(op)] = j_recv(g, 0);
-}
-
 static void irgen_op_convstr(jit_irgen_t *g, int op)
 {
    jit_value_t value = irgen_get_arg(g, op, 0);
@@ -3834,9 +3806,6 @@ static void irgen_block(jit_irgen_t *g, vcode_block_t block)
       case VCODE_OP_CLEAR_EVENT:
          irgen_op_clear_event(g, i);
          break;
-      case VCODE_OP_STRCONV:
-         irgen_op_strconv(g, i);
-         break;
       case VCODE_OP_CONVSTR:
          irgen_op_convstr(g, i);
          break;