Integer subtype mirrors and subtype reflection

lib/std.19/reflection-body.vhd

@@ -18,6 +18,30 @@ package body reflection is
 
     type string_ptr is access string;
 
+    type internal_type;
+    type type_ptr is access internal_type;
+
+    type cache_elem_t is record
+        f_type    : type_ptr;
+        f_subtype : subtype_mirror;
+    end record;
+
+    type cache_ptr is access cache_elem_t;
+
+    type internal_cache_pt is protected
+        -- No methods, used internally
+    end protected;
+
+    type internal_cache_pt is protected body
+        variable f_canary1       : integer := 16#deadbeef#;
+        variable f_subtype_cache : cache_ptr;
+        variable f_num_subtypes  : natural;
+        variable f_max_subtypes  : natural;
+        variable f_canary2       : integer := 16#cafebabe#;
+    end protected body;
+
+    shared variable cache : internal_cache_pt;
+
     ---------------------------------------------------------------------------
 
     type enumeration_value_mirror_pt is protected body
@@ -129,7 +153,13 @@ package body reflection is
     ---------------------------------------------------------------------------
 
     type integer_subtype_mirror_pt is protected body
-        variable f_owner : subtype_mirror;
+        variable f_owner     : subtype_mirror;
+        variable f_left      : integer_value_mirror;
+        variable f_right     : integer_value_mirror;
+        variable f_low       : integer_value_mirror;
+        variable f_high      : integer_value_mirror;
+        variable f_length    : index;
+        variable f_ascending : boolean;
 
         impure function to_subtype_mirror return subtype_mirror is
         begin
@@ -143,32 +173,32 @@ package body reflection is
 
         impure function left return integer_value_mirror is
         begin
-            report "unimplemented" severity failure;
+            return f_left;
         end function;
 
         impure function right return integer_value_mirror is
         begin
-            report "unimplemented" severity failure;
+            return f_right;
         end function;
 
         impure function low return integer_value_mirror is
         begin
-            report "unimplemented" severity failure;
+            return f_low;
         end function;
 
         impure function high return integer_value_mirror is
         begin
-            report "unimplemented" severity failure;
+            return f_high;
         end function;
 
         impure function length return index is
         begin
-            report "unimplemented" severity failure;
+            return f_length;
         end function;
 
         impure function ascending return boolean is
         begin
-            report "unimplemented" severity failure;
+            return f_ascending;
         end function;
     end protected body;
 

src/jit/jit-exits.c

@@ -1144,6 +1144,15 @@ void __nvc_do_exit(jit_exit_t which, jit_anchor_t *anchor, jit_scalar_t *args,
       }
       break;
 
+   case JIT_EXIT_REFLECT_SUBTYPE:
+      {
+         void   *context = args[0].pointer;
+         tree_t  where   = args[1].pointer;
+
+         args[0].pointer = x_reflect_subtype(context, where, args + 3);
+      }
+      break;
+
    default:
       fatal_trace("unhandled exit %s", jit_exit_name(which));
    }

src/jit/jit-exits.h

@@ -98,5 +98,7 @@ void x_clear_event(sig_shared_t *ss, uint32_t offset, int32_t count);
 void x_enter_state(int32_t state);
 void *x_reflect_value(void *context, jit_scalar_t value, tree_t where,
                       const jit_scalar_t *bounds);
+void *x_reflect_subtype(void *context, tree_t where,
+                        const jit_scalar_t *bounds);
 
 #endif  // _JIT_EXITS_H

src/jit/jit-irgen.c

@@ -2370,6 +2370,31 @@ static void irgen_op_reflect_value(jit_irgen_t *g, int op)
    g->map[vcode_get_result(op)] = j_recv(g, 0);
 }
 
+static void irgen_op_reflect_subtype(jit_irgen_t *g, int op)
+{
+   jit_value_t context = irgen_get_arg(g, op, 0);
+   jit_value_t locus = irgen_get_arg(g, op, 1);
+
+   j_send(g, 0, context);
+   j_send(g, 1, locus);
+
+   if (vcode_count_args(op) > 2) {
+      vcode_reg_t vreg = vcode_get_arg(op, 2);
+      const int slots = irgen_slots_for_type(vcode_reg_type(vreg));
+      if (slots > 1) {
+         jit_reg_t base = jit_value_as_reg(irgen_get_value(g, vreg));
+         for (int j = 0; j < slots; j++)
+            j_send(g, j + 2, jit_value_from_reg(base + j));
+      }
+      else
+         j_send(g, 2, irgen_get_value(g, vreg));
+   }
+
+   macro_exit(g, JIT_EXIT_REFLECT_SUBTYPE);
+
+   g->map[vcode_get_result(op)] = j_recv(g, 0);
+}
+
 static void irgen_op_process_init(jit_irgen_t *g, int op)
 {
    jit_value_t locus = irgen_get_arg(g, op, 0);
@@ -3731,6 +3756,9 @@ static void irgen_block(jit_irgen_t *g, vcode_block_t block)
       case VCODE_OP_REFLECT_VALUE:
          irgen_op_reflect_value(g, i);
          break;
+      case VCODE_OP_REFLECT_SUBTYPE:
+         irgen_op_reflect_subtype(g, i);
+         break;
       case VCODE_OP_PROCESS_INIT:
          irgen_op_process_init(g, i);
          break;
@@ -3864,7 +3892,7 @@ static void irgen_locals(jit_irgen_t *g, bool force_stack)
       // Local variables on heap
       size_t sz = 0;
       sz += sizeof(void *);   // Context parameter
-      if (kind != VCODE_UNIT_PROTECTED) {
+      if (kind == VCODE_UNIT_PROCESS || kind == VCODE_UNIT_PROCEDURE) {
          sz += sizeof(void *);   // Suspended procedure state
          sz += sizeof(int32_t);  // State number
       }

src/lower.c

@@ -4472,16 +4472,14 @@ static vcode_reg_t lower_reflect_attr(lower_unit_t *lu, tree_t expr)
    if (type_is_array(value_type))
       bounds_reg = lower_wrap(lu, value_type, value_reg);
 
-   vcode_reg_t result_reg;
-   if (is_value_mirror) {
-      vcode_reg_t locus = lower_debug_locus(name);
-      result_reg = emit_reflect_value(init_func, value_reg, context_reg,
-                                      locus, bounds_reg);
-   }
-   else
-      fatal_at(tree_loc(expr), "sorry, subtype mirrors not yet supported");
+   vcode_reg_t locus = lower_debug_locus(name);
 
-   return result_reg;
+   if (is_value_mirror)
+      return emit_reflect_value(init_func, value_reg, context_reg,
+                                locus, bounds_reg);
+   else
+      return emit_reflect_subtype(init_func, context_reg,
+                                  locus, bounds_reg);
 }
 
 static vcode_reg_t lower_attr_ref(lower_unit_t *lu, tree_t expr)

src/rt/reflect.c

@@ -23,6 +23,7 @@
 
 #include <assert.h>
 #include <string.h>
+#include <stdlib.h>
 
 typedef enum {
    CLASS_ENUMERATION,
@@ -38,10 +39,31 @@ typedef enum {
 
 typedef struct _value_mirror value_mirror;
 typedef struct _subtype_mirror subtype_mirror;
+typedef struct _integer_value_mirror integer_value_mirror;
 
 typedef struct {
-   void           *context;
-   subtype_mirror *f_owner;
+   type_t          f_type;
+   subtype_mirror *f_mirror;
+} cache_elem_t;
+
+typedef struct {
+   void         *context;
+   int64_t       f_canary1;
+   cache_elem_t *f_subtype_cache;
+   int64_t       f_num_subtypes;
+   int64_t       f_max_subtypes;
+   int64_t       f_canary2;
+} internal_cache_pt;
+
+typedef struct {
+   void                 *context;
+   subtype_mirror       *f_owner;
+   integer_value_mirror *f_left;
+   integer_value_mirror *f_right;
+   integer_value_mirror *f_low;
+   integer_value_mirror *f_high;
+   int64_t               f_length;
+   uint8_t               f_ascending;
 } integer_subtype_mirror_pt;
 
 typedef struct {
@@ -67,7 +89,7 @@ typedef struct {
    int64_t                 f_value;
 } integer_value_mirror_pt;
 
-typedef struct {
+typedef struct _integer_value_mirror {
    void                    *access;
    integer_value_mirror_pt  pt;
 } integer_value_mirror;
@@ -133,6 +155,16 @@ static ffi_uarray_t *get_string(const char *str)
    return u;
 }
 
+static internal_cache_pt *get_cache(void *context)
+{
+   // This will break if the package layout ever changes
+   internal_cache_pt *pt = *(internal_cache_pt **)(context + sizeof(void *));
+   assert(pt->f_canary1 == 0xdeadbeef);
+   assert(pt->f_canary2 == 0xcafebabe);
+   assert(pt->context == context);
+   return pt;
+}
+
 static value_mirror *get_value_mirror(void *context, jit_scalar_t value,
                                       type_t type, const jit_scalar_t *bounds)
 {
@@ -172,24 +204,69 @@ static value_mirror *get_value_mirror(void *context, jit_scalar_t value,
    return vm;
 }
 
+static integer_value_mirror *get_integer_mirror(void *context, type_t type,
+                                                int64_t value)
+{
+   jit_scalar_t scalar = { .integer = value };
+   return get_value_mirror(context, scalar, type, NULL)->pt.f_integer;
+}
+
 static subtype_mirror *get_subtype_mirror(void *context, type_t type,
                                           const jit_scalar_t *bounds)
 {
-   // TODO: cache this (safely)
+   internal_cache_pt *cache = get_cache(context);
+
+   for (int i = 0; i < cache->f_num_subtypes; i++) {
+      cache_elem_t *e = &(cache->f_subtype_cache[i]);
+      if (e->f_type == type)
+         return e->f_mirror;
+   }
 
    subtype_mirror *sm = zero_alloc(sizeof(subtype_mirror));
    sm->access = &(sm->pt);
    sm->pt.context = context;
 
+   if (cache->f_num_subtypes == cache->f_max_subtypes) {
+      const size_t new_max = MAX(cache->f_max_subtypes * 2, 128);
+      cache_elem_t *tmp = zero_alloc(new_max * sizeof(cache_elem_t));
+      memcpy(tmp, cache->f_subtype_cache,
+             cache->f_max_subtypes * sizeof(cache_elem_t));
+
+      cache->f_subtype_cache = tmp;
+      cache->f_max_subtypes = new_max;
+   }
+
+   cache_elem_t *e = &(cache->f_subtype_cache[cache->f_num_subtypes++]);
+   e->f_type = type;
+   e->f_mirror = sm;
+
    const char *simple = strrchr(istr(type_ident(type)), '.') + 1;
    sm->pt.f_name = get_string(simple);
 
    if (type_is_integer(type)) {
       integer_subtype_mirror *ism = zero_alloc(sizeof(integer_subtype_mirror));
       ism->access = &(ism->pt);
 
+      tree_t r = range_of(type, 0);
+      const range_kind_t rkind = tree_subkind(r);
+      if (rkind == RANGE_EXPR)
+         abort();  // TODO
+
+      int64_t low, high;
+      if (!folded_bounds(r, &low, &high))
+         abort();  // TODO
+
       ism->pt.context = context;
       ism->pt.f_owner = sm;
+      ism->pt.f_ascending = (rkind == RANGE_TO);
+      ism->pt.f_length = MAX(high - low + 1, 0);   // TODO: this can overflow
+
+      type_t index = index_type_of(type, 0);
+      ism->pt.f_low = get_integer_mirror(context, index, low);
+      ism->pt.f_high = get_integer_mirror(context, index, high);
+
+      ism->pt.f_left = (rkind == RANGE_TO) ? ism->pt.f_low : ism->pt.f_high;
+      ism->pt.f_right = (rkind == RANGE_TO) ? ism->pt.f_high : ism->pt.f_low;
 
       sm->pt.f_class = CLASS_INTEGER;
       sm->pt.f_integer = ism;
@@ -218,6 +295,11 @@ void *x_reflect_value(void *context, jit_scalar_t value, tree_t where,
    return get_value_mirror(context, value, tree_type(where), bounds);
 }
 
+void *x_reflect_subtype(void *context, tree_t where, const jit_scalar_t *bounds)
+{
+   return get_subtype_mirror(context, tree_type(where), bounds);
+}
+
 void _std_reflection_init(void)
 {
    // Dummy function to force linking

src/rt/rt.h

@@ -23,7 +23,7 @@
 
 #include <stdint.h>
 
-#define RT_ABI_VERSION   18
+#define RT_ABI_VERSION   19
 #define RT_ALIGN_MASK    0x7
 #define RT_MULTITHREADED 0
 

src/vcode.c

@@ -961,7 +961,7 @@ const char *vcode_op_string(vcode_op_t op)
       "trap sub", "trap mul", "force", "release", "link instance",
       "unreachable", "package init", "strconv", "canon value", "convstr",
       "trap neg", "process init", "clear event", "trap exp", "implicit event",
-      "enter state", "reflect value"
+      "enter state", "reflect value", "reflect subtype",
    };
    if ((unsigned)op >= ARRAY_LEN(strs))
       return "???";
@@ -2261,6 +2261,22 @@ void vcode_dump_with_mark(int mark_op, vcode_dump_fn_t callback, void *arg)
                vcode_dump_result_type(col, op);
             }
             break;
+
+         case VCODE_OP_REFLECT_SUBTYPE:
+            {
+               col += vcode_dump_reg(op->result);
+               col += printf(" := %s ", vcode_op_string(op->kind));
+               col += printf(" context ");
+               vcode_dump_reg(op->args.items[0]);
+               col += printf(" locus ");
+               col += vcode_dump_reg(op->args.items[1]);
+               if (op->args.count > 2) {
+                  col += printf(" bounds ");
+                  col += vcode_dump_reg(op->args.items[2]);
+               }
+               vcode_dump_result_type(col, op);
+            }
+            break;
          }
 
          if (j == mark_op && i == old_block)
@@ -5885,6 +5901,23 @@ vcode_reg_t emit_reflect_value(ident_t ptype, vcode_reg_t value,
    return (op->result = vcode_add_reg(vtype_access(vtype_context(ptype))));
 }
 
+vcode_reg_t emit_reflect_subtype(ident_t ptype, vcode_reg_t context,
+                                 vcode_reg_t locus, vcode_reg_t bounds)
+{
+   op_t *op = vcode_add_op(VCODE_OP_REFLECT_SUBTYPE);
+   vcode_add_arg(op, context);
+   vcode_add_arg(op, locus);
+   if (bounds != VCODE_INVALID_REG)
+      vcode_add_arg(op, bounds);
+
+   VCODE_ASSERT(vcode_reg_kind(context) == VCODE_TYPE_CONTEXT,
+                "invalid reflect value context argument");
+   VCODE_ASSERT(vcode_reg_kind(locus) == VCODE_TYPE_DEBUG_LOCUS,
+                "locus argument to reflect value must be a debug locus");
+
+   return (op->result = vcode_add_reg(vtype_access(vtype_context(ptype))));
+}
+
 static void vcode_write_unit(vcode_unit_t unit, fbuf_t *f,
                              ident_wr_ctx_t ident_wr_ctx,
                              loc_wr_ctx_t *loc_wr_ctx)