diff --git a/lib/nvc/text_util-body.vhd b/lib/nvc/text_util-body.vhd index 741693a41..f1aa1f003 100644 --- a/lib/nvc/text_util-body.vhd +++ b/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; diff --git a/lib/nvc/text_util.vhd b/lib/nvc/text_util.vhd index 238fa1d65..bc82027dd 100644 --- a/lib/nvc/text_util.vhd +++ b/lib/nvc/text_util.vhd @@ -27,9 +27,18 @@ 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; @@ -37,6 +46,4 @@ package text_util is 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; diff --git a/src/jit/jit-dump.c b/src/jit/jit-dump.c index e970536b5..dd97d999c 100644 --- a/src/jit/jit-dump.c +++ b/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]; diff --git a/src/jit/jit-irgen.c b/src/jit/jit-irgen.c index 63311d6d4..eef0b0d5e 100644 --- a/src/jit/jit-irgen.c +++ b/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; diff --git a/src/lower.c b/src/lower.c index a4949a465..be2542e73 100644 --- a/src/lower.c +++ b/src/lower.c @@ -8395,13 +8395,30 @@ static void lower_physical_value_helper(lower_unit_t *lu, type_t type, vcode_type_t vint64 = vtype_int(INT64_MIN, INT64_MAX); vcode_type_t vstring = vtype_uarray(1, vchar, vchar); - vcode_var_t used_var = lower_temp_var(lu, "used", voffset, voffset); + vcode_type_t vstdint = (standard() < STD_19) + ? vtype_int(INT32_MIN, INT32_MAX) : vtype_int(INT64_MIN, INT64_MAX); + + vcode_var_t used_var = lower_temp_var(lu, "used", vstdint, vstdint); vcode_reg_t used_ptr = emit_index(used_var, VCODE_INVALID_REG); - vcode_reg_t int_reg = emit_strconv(arg_data_reg, arg_len_reg, - used_ptr, vint64); + vcode_var_t int_var = lower_temp_var(lu, "int", vint64, vint64); + vcode_reg_t int_ptr = emit_index(int_var, VCODE_INVALID_REG); + + ident_t conv_fn = + ident_new("NVC.TEXT_UTIL.STRING_TO_INT(S21NVC.TEXT_UTIL.T_INT64N)"); + vcode_reg_t text_util_reg = lower_context_for_call(lu, conv_fn); + vcode_reg_t conv_args[] = { + text_util_reg, + preg, + int_ptr, + used_ptr, + }; + emit_fcall(conv_fn, VCODE_INVALID_TYPE, VCODE_INVALID_TYPE, + VCODE_CC_VHDL, conv_args, ARRAY_LEN(conv_args)); + + vcode_reg_t int_reg = emit_load(int_var); + vcode_reg_t used_reg = emit_cast(voffset, voffset, emit_load(used_var)); - vcode_reg_t used_reg = emit_load_indirect(used_ptr); vcode_reg_t tail_ptr = emit_array_ref(arg_data_reg, used_reg); vcode_reg_t tail_len = emit_sub(arg_len_reg, used_reg); @@ -8418,7 +8435,7 @@ static void lower_physical_value_helper(lower_unit_t *lu, type_t type, ident_t canon_fn = ident_new("NVC.TEXT_UTIL.CANON_VALUE(S)S"); vcode_reg_t canon_args[] = { - lower_context_for_call(lu, canon_fn), + text_util_reg, tail_reg, }; vcode_reg_t canon_reg = emit_fcall(canon_fn, vstring, vchar, VCODE_CC_VHDL, @@ -8559,14 +8576,30 @@ static void lower_physical_value_helper(lower_unit_t *lu, type_t type, static void lower_numeric_value_helper(lower_unit_t *lu, type_t type, tree_t decl, vcode_reg_t preg) { - vcode_reg_t len_reg = emit_uarray_len(preg, 0); - vcode_reg_t data_reg = emit_unwrap(preg); + vcode_reg_t result_reg; + if (type_is_real(type)) { + ident_t conv_fn = ident_new("NVC.TEXT_UTIL.STRING_TO_REAL(S)R"); - vcode_type_t vint64 = vtype_int(INT64_MIN, INT64_MAX); - vcode_type_t vreal = vtype_real(-DBL_MAX, DBL_MAX); + vcode_reg_t text_util_reg = lower_context_for_call(lu, conv_fn); + vcode_reg_t conv_args[] = { text_util_reg, preg }; - vcode_reg_t result_reg = emit_strconv(data_reg, len_reg, VCODE_INVALID_REG, - type_is_real(type) ? vreal : vint64); + vcode_type_t vreal = vtype_real(-DBL_MAX, DBL_MAX); + + result_reg = emit_fcall(conv_fn, vreal, vreal, VCODE_CC_VHDL, + conv_args, ARRAY_LEN(conv_args)); + } + else { + ident_t conv_fn = + ident_new("NVC.TEXT_UTIL.STRING_TO_INT(S)21NVC.TEXT_UTIL.T_INT64"); + + vcode_reg_t text_util_reg = lower_context_for_call(lu, conv_fn); + vcode_reg_t conv_args[] = { text_util_reg, preg }; + + vcode_type_t vint64 = vtype_int(INT64_MIN, INT64_MAX); + + result_reg = emit_fcall(conv_fn, vint64, vint64, VCODE_CC_VHDL, + conv_args, ARRAY_LEN(conv_args)); + } vcode_type_t vtype = lower_type(type); vcode_type_t vbounds = lower_bounds(type); diff --git a/src/vcode.c b/src/vcode.c index efe82b3eb..556bf8c9c 100644 --- a/src/vcode.c +++ b/src/vcode.c @@ -40,7 +40,7 @@ DECLARE_AND_DEFINE_ARRAY(vcode_type); (x == VCODE_OP_ALLOC || x == VCODE_OP_COPY \ || x == VCODE_OP_CONST || x == VCODE_OP_CAST \ || x == VCODE_OP_CONST_RECORD || x == VCODE_OP_CLOSURE \ - || x == VCODE_OP_PUSH_SCOPE || x == VCODE_OP_STRCONV) + || x == VCODE_OP_PUSH_SCOPE) #define OP_HAS_ADDRESS(x) \ (x == VCODE_OP_LOAD || x == VCODE_OP_STORE || x == VCODE_OP_INDEX \ || x == VCODE_OP_VAR_UPREF) @@ -954,7 +954,7 @@ const char *vcode_op_string(vcode_op_t op) "range length", "exponent check", "zero check", "map const", "resolve signal", "push scope", "pop scope", "alias signal", "trap add", "trap sub", "trap mul", "force", "release", "link instance", - "unreachable", "package init", "strconv", "canon value", "convstr", + "unreachable", "package init", "canon value", "convstr", "trap neg", "process init", "clear event", "trap exp", "implicit event", "enter state", "reflect value", "reflect subtype", "function trigger", "add trigger", @@ -1661,21 +1661,6 @@ void vcode_dump_with_mark(int mark_op, vcode_dump_fn_t callback, void *arg) } break; - case VCODE_OP_STRCONV: - { - col += vcode_dump_reg(op->result); - col += printf(" := %s ", vcode_op_string(op->kind)); - col += vcode_dump_reg(op->args.items[0]); - col += printf(" length "); - col += vcode_dump_reg(op->args.items[1]); - if (op->args.count > 2) { - col += printf(" used "); - col += vcode_dump_reg(op->args.items[2]); - } - vcode_dump_result_type(col, op); - } - break; - case VCODE_OP_COMMENT: { color_printf("$cyan$// %s$$ ", op->comment); @@ -5668,34 +5653,6 @@ vcode_reg_t emit_undefined(vcode_type_t type, vcode_type_t bounds) return op->result; } -vcode_reg_t emit_strconv(vcode_reg_t ptr, vcode_reg_t len, vcode_reg_t used_ptr, - vcode_type_t type) -{ - VCODE_FOR_EACH_MATCHING_OP(other, VCODE_OP_STRCONV) { - if (other->args.items[0] == ptr && other->args.items[1] == len - && other->type == type && used_ptr == VCODE_INVALID_REG) - return other->result; - } - - op_t *op = vcode_add_op(VCODE_OP_STRCONV); - vcode_add_arg(op, ptr); - vcode_add_arg(op, len); - if (used_ptr != VCODE_INVALID_REG) - vcode_add_arg(op, used_ptr); - op->type = type; - - VCODE_ASSERT(vcode_reg_kind(ptr) == VCODE_TYPE_POINTER, - "strconv ptr argument must be pointer"); - VCODE_ASSERT(vcode_reg_kind(len) == VCODE_TYPE_OFFSET, - "strconv len argument must be offset"); - VCODE_ASSERT(used_ptr == VCODE_INVALID_REG - || vcode_reg_kind(used_ptr) == VCODE_TYPE_POINTER, - "strconv used_ptr argument must be pointer"); - VCODE_ASSERT(vtype_is_scalar(type), "strconv result must be scalar"); - - return (op->result = vcode_add_reg(type)); -} - vcode_reg_t emit_convstr(vcode_reg_t value) { VCODE_FOR_EACH_MATCHING_OP(other, VCODE_OP_CONVSTR) { diff --git a/src/vcode.h b/src/vcode.h index d7dc8f035..0615e292e 100644 --- a/src/vcode.h +++ b/src/vcode.h @@ -150,7 +150,6 @@ typedef enum { VCODE_OP_LINK_INSTANCE, VCODE_OP_UNREACHABLE, VCODE_OP_PACKAGE_INIT, - VCODE_OP_STRCONV, VCODE_OP_CONVSTR, VCODE_OP_TRAP_NEG, VCODE_OP_PROCESS_INIT, @@ -514,8 +513,6 @@ void emit_push_scope(vcode_reg_t locus, vcode_type_t type); void emit_pop_scope(void); void emit_alias_signal(vcode_reg_t signal, vcode_reg_t locus); void emit_unreachable(vcode_reg_t locus); -vcode_reg_t emit_strconv(vcode_reg_t ptr, vcode_reg_t len, vcode_reg_t used_ptr, - vcode_type_t type); vcode_reg_t emit_convstr(vcode_reg_t value); void emit_enter_state(vcode_reg_t state); vcode_reg_t emit_reflect_value(ident_t ptype, vcode_reg_t value, diff --git a/test/jitperf.c b/test/jitperf.c index 15d8c5925..46e9bcb1a 100644 --- a/test/jitperf.c +++ b/test/jitperf.c @@ -120,7 +120,7 @@ static void find_benchmarks(tree_t pack, const char *filter, const int ndecls = tree_decls(pack); for (int i = 0; i < ndecls; i++) { tree_t d = tree_decl(pack, i); - if (tree_kind(d) != T_PROC_DECL) + if (!is_subprogram(d)) continue; ident_t id = tree_ident(d); diff --git a/test/perf/value.vhd b/test/perf/value.vhd new file mode 100644 index 000000000..9b01fbae3 --- /dev/null +++ b/test/perf/value.vhd @@ -0,0 +1,30 @@ +package value is + impure function test_string2int return integer; + impure function test_string2real return real; + impure function test_string2phys return time; +end package; + +package body value is + + impure function test_string2int return integer is + variable s : string(1 to 10); + begin + s := "1234567890"; + return integer'value(s); + end function; + + impure function test_string2real return real is + variable s : string(1 to 11); + begin + s := "15.12511e-7"; + return real'value(s); + end function; + + impure function test_string2phys return time is + variable s : string(1 to 8); + begin + s := "16231 ns"; + return time'value(s); + end function; + +end package body; diff --git a/test/regress/value1.vhd b/test/regress/value1.vhd index 27cd446b7..41891ca7d 100644 --- a/test/regress/value1.vhd +++ b/test/regress/value1.vhd @@ -8,6 +8,7 @@ begin type my_small_int is range 1 to 10; type my_enum is (A, B, C, D); type my_real is range -5.0 to 5.0; + type big_real is range -1.7976931348623157e308 to 1.7976931348623157e308; subtype my_sub is my_enum range B to C; type resistance is range 0 to 10000000 units @@ -15,12 +16,6 @@ begin kohm = 1000 ohm; mohm = 1000 kohm; end units; - - function "="(l, r : my_real) return boolean is - begin - return l > r - 0.0001 and l < r + 0.0001; - end function; - begin assert integer'value("1") = 1; assert integer'value("-1") = -1; @@ -43,6 +38,11 @@ begin assert my_real'value("1.23") = 1.23; assert my_real'value(" 4.2 ") = 4.2; + assert my_real'value("-5e-1") = -0.5; + assert my_real'value("1.3e-5") = 1.3e-5; + + assert big_real'value("-623.0001") = -623.0001; + assert big_real'value("123456789123.0e2") = 12345678912300.0; wait; end process; diff --git a/test/test_jit.c b/test/test_jit.c index 685bd0300..d08c6f4fc 100644 --- a/test/test_jit.c +++ b/test/test_jit.c @@ -1052,8 +1052,8 @@ START_TEST(test_value1) input_from_file(TESTDIR "/jit/value1.vhd"); const error_t expect[] = { - { 72, "found invalid characters \"x\" after value \"42x\"" }, - { 76, "invalid real value \"4..4\"" }, + { 239, "found invalid characters \"x\" after value \"42x\"" }, + { 387, "found invalid characters \".4\" after value \"4..4\"" }, { 80, "\" FOO\" is not a valid unit name" }, { 23, "\"FOO\" is not a valid enumeration value" }, { -1, NULL }, @@ -1070,7 +1070,7 @@ START_TEST(test_value1) ck_assert_int_eq(jit_call(j, fn1, NULL, "123", 1, 3).integer, 123); ck_assert_int_eq(jit_call(j, fn1, NULL, "-5", 1, 2).integer, -5); ck_assert_int_eq(jit_call(j, fn1, NULL, " 42 ", 1, 4).integer, 42); - fail_if(jit_try_call(j, fn1, &result, NULL, "42x", 1, 4)); + fail_if(jit_try_call(j, fn1, &result, NULL, "42x", 1, 3)); jit_handle_t fn2 = compile_for_test(j, "WORK.VALUE1.STR_TO_REAL(S)R"); ck_assert_double_eq(jit_call(j, fn2, NULL, "123", 1, 3).real, 123.0);