Code generation for accesses to protected types

NEWS.md

@@ -36,6 +36,7 @@
 - The `-a` analysis command now accepts an `-f list` option where `list`
   is a text file containing a list of files to analyse.  Alternatively
   this may be written `@list`.
+- Accesses to protected types and files are now allowed in VHDL-2019.
 
 ## Version 1.9.2 - 2023-05-01
 - Fix elaboration errors with recursive entity instantiation (#668).

src/jit/jit-irgen.c

@@ -3848,7 +3848,15 @@ static void irgen_locals(jit_irgen_t *g, bool force_stack)
          sz += irgen_size_bytes(vtype);
       }
 
-      jit_value_t mem = macro_lalloc(g, jit_value_from_int64(sz));
+      jit_value_t mem;
+      if (kind == VCODE_UNIT_PROTECTED) {
+         // Protected types must always be allocated on the global heap
+         // as the result may be stored in an access
+         mem = macro_galloc(g, jit_value_from_int64(sz));
+      }
+      else
+         mem = macro_lalloc(g, jit_value_from_int64(sz));
+
       if (g->statereg.kind != JIT_VALUE_INVALID) {
          // A null state was passed in by the caller
          j_mov(g, jit_value_as_reg(g->statereg), mem);

src/lower.c

@@ -4294,6 +4294,15 @@ static vcode_reg_t lower_new(lower_unit_t *lu, tree_t expr)
       lower_new_record(lu, type, all_reg, init_reg);
       return result_reg;
    }
+   else if (type_is_protected(type)) {
+      vcode_type_t vtype = lower_type(type);
+      vcode_reg_t context_reg = lower_context_for_call(type_ident(type));
+      vcode_reg_t obj_reg = emit_protected_init(vtype, context_reg);
+      vcode_reg_t result_reg = emit_new(vtype, VCODE_INVALID_REG);
+      vcode_reg_t all_reg = emit_all(result_reg);
+      emit_store_indirect(obj_reg, all_reg);
+      return result_reg;
+   }
    else {
       vcode_reg_t result_reg = emit_new(lower_type(type), VCODE_INVALID_REG);
       vcode_reg_t all_reg = emit_all(result_reg);

src/vcode.c

@@ -5279,7 +5279,7 @@ vcode_reg_t emit_new(vcode_type_t type, vcode_reg_t length)
    vtype_kind_t kind = vtype_kind(type);
    VCODE_ASSERT(kind == VCODE_TYPE_INT || kind == VCODE_TYPE_RECORD
                 || kind == VCODE_TYPE_UARRAY || kind == VCODE_TYPE_ACCESS
-                || kind == VCODE_TYPE_REAL,
+                || kind == VCODE_TYPE_REAL || kind == VCODE_TYPE_CONTEXT,
                 "new type must be int, real, record, access, or uarray");
    VCODE_ASSERT(length == VCODE_INVALID_REG
                 || vtype_kind(vcode_reg_type(length)) == VCODE_TYPE_OFFSET,

test/regress/protected10.vhd

@@ -0,0 +1,61 @@
+entity protected10 is
+end entity;
+
+architecture test of protected10 is
+
+    type counter_t is protected
+        procedure increment;
+        procedure decrement;
+        impure function value return natural;
+    end protected;
+
+    type counter_t is protected body
+        variable val : natural := 0;
+
+        procedure increment is
+        begin
+            val := val + 1;
+        end procedure;
+
+        procedure decrement is
+        begin
+            val := val - 1;
+        end procedure;
+
+        impure function value return natural is
+        begin
+            return val;
+        end function;
+    end protected body;
+
+    type counter_ptr_t is access counter_t;
+
+    procedure call_increment (p : inout counter_ptr_t; n : in natural) is
+    begin
+        for i in 1 to n loop
+            p.increment;
+        end loop;
+    end procedure;
+begin
+
+    p1: process is
+        variable p, p2 : counter_ptr_t;
+    begin
+        p := new counter_t;
+        assert p.all.value = 0;
+        p.increment;
+        assert p.value = 1;
+        call_increment(p, 5);
+        assert p.value = 6;
+        wait for 1 ns;
+        for i in 1 to 10 loop
+            -- Make sure the allocation of P was not in the thread local buffer
+            p2 := new counter_t;
+        end loop;
+        assert p.value = 6;
+        deallocate(p);
+        assert p = null;
+        wait;
+    end process;
+
+end architecture;

test/regress/testlist.txt

@@ -810,3 +810,4 @@ issue718        normal,gold,2008
 issue726        normal,2008
 issue724        normal,2019
 issue653        normal,2008
+protected10     normal,2019