Fix crash with long running procedure suspending in loop. Issue #412

HISTORY.md

@@ -1,6 +1,7 @@
 ## 1.5.2 - unreleased
 - Link libexecinfo on FreeBSD.
 - Implement textio READ procedure for BIT and TIME (#408).
+- Fixed a crash when a long running procedure suspends in a loop (#412).
 
 ## 1.5.1 - 2021-09-04
 - Fix a compiler warning in vcode.c.

src/lower.c

@@ -3540,6 +3540,17 @@ static void lower_pcall(tree_t pcall)
    else {
       const int hops = nest_depth > 0 ? vcode_unit_depth() - nest_depth : 0;
       vcode_block_t resume_bb = emit_block();
+
+      // Save the temp stack mark in a variable so it is preserved
+      // across suspend/resume
+      vcode_var_t tmp_mark_var = VCODE_INVALID_VAR;
+      if (tmp_alloc_used) {
+         ident_t tmp_mark_i = ident_new("tmp_mark");
+         if ((tmp_mark_var = vcode_find_var(tmp_mark_i)) == VCODE_INVALID_VAR)
+            tmp_mark_var = emit_var(vtype_offset(), vtype_offset(), tmp_mark_i, false);
+         emit_store(saved_heap, tmp_mark_var);
+      }
+
       if (nest_depth > 0) {
          emit_nested_pcall(name, args, nargs, resume_bb, hops);
          vcode_select_block(resume_bb);
@@ -3550,6 +3561,9 @@ static void lower_pcall(tree_t pcall)
          vcode_select_block(resume_bb);
          emit_resume(name);
       }
+
+      if (tmp_alloc_used)
+         lower_cleanup_temp_objects(emit_load(tmp_mark_var));
    }
 }
 

src/vcode.c

@@ -4806,8 +4806,6 @@ void emit_heap_restore(vcode_reg_t reg)
 
    VCODE_ASSERT(vcode_reg_kind(reg) == VCODE_TYPE_OFFSET,
                 "saved heap must have offset type");
-   VCODE_ASSERT(vcode_find_definition(reg)->kind == VCODE_OP_HEAP_SAVE,
-                "register for heap restore must come from heap save");
 }
 
 vcode_reg_t emit_undefined(vcode_type_t type)

test/regress/issue412.vhd

@@ -0,0 +1,54 @@
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+entity issue412 is
+end issue412;
+
+architecture behavioral of issue412 is
+  signal clk : std_logic := '0';
+  signal running : boolean := true;
+begin
+
+  process (clk, running)
+  begin
+    if running then
+      clk <= not clk after 5 ns;
+    end if;
+  end process;
+
+  process
+    -- Overloading the name is not the issue.
+    procedure wr_data(data : signed) is
+    begin
+      -- A delay here seems to be necessary to cause the issue.
+      wait until clk = '1';
+--      wait for 10 ns;
+    end;
+
+    -- Calling from this function to the next seems
+    -- to be required for the crash.
+    procedure wr_data(data : integer) is
+    begin
+      wr_data(to_signed(data, 32));
+    end;
+
+    variable data : signed(31 downto 0);
+  begin
+    -- Loop to 2000 works with line A below.
+--    for n in 1 to 2000 loop
+    -- Loop to 3000 does not work with line A below.
+    for n in 1 to 3000 loop
+    -- Loop to 3000000 works fine with lines B below.
+--    for n in 1 to 3000000 loop
+      wr_data(n);                -- A
+--      data := to_signed(n, 32);  -- B
+--      wr_data(data);             -- B
+    end loop;
+
+    assert false report "Test OK" severity note;
+    running <= false;
+    wait;
+  end process;
+
+end behavioral;

test/regress/testlist.txt

@@ -352,3 +352,4 @@ stack1          normal
 issue377        gold,normal,relax=prefer-explicit
 issue397        normal
 wait14          normal
+issue412        normal