From 3256ba1a5fb5a079211ec33d2d2c2d790212aca8 Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Sat, 24 Jun 2023 20:43:03 +0100
Subject: [PATCH] Code generation for accesses to protected types

---
 NEWS.md                      |  1 +
 src/jit/jit-irgen.c          | 10 +++++-
 src/lower.c                  |  9 ++++++
 src/vcode.c                  |  2 +-
 test/regress/protected10.vhd | 61 ++++++++++++++++++++++++++++++++++++
 test/regress/testlist.txt    |  1 +
 6 files changed, 82 insertions(+), 2 deletions(-)
 create mode 100644 test/regress/protected10.vhd

diff --git a/NEWS.md b/NEWS.md
index fcc5ea765..9af7348a5 100644
--- a/NEWS.md
+++ b/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).
diff --git a/src/jit/jit-irgen.c b/src/jit/jit-irgen.c
index b465e8bdb..625307d6c 100644
--- a/src/jit/jit-irgen.c
+++ b/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);
diff --git a/src/lower.c b/src/lower.c
index 6b7474205..3ae87a140 100644
--- a/src/lower.c
+++ b/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);
diff --git a/src/vcode.c b/src/vcode.c
index 858e1d99d..feaefb8ef 100644
--- a/src/vcode.c
+++ b/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,
diff --git a/test/regress/protected10.vhd b/test/regress/protected10.vhd
new file mode 100644
index 000000000..2e6f55658
--- /dev/null
+++ b/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;
diff --git a/test/regress/testlist.txt b/test/regress/testlist.txt
index d9457c829..688bd4907 100644
--- a/test/regress/testlist.txt
+++ b/test/regress/testlist.txt
@@ -810,3 +810,4 @@ issue718        normal,gold,2008
 issue726        normal,2008
 issue724        normal,2019
 issue653        normal,2008
+protected10     normal,2019