Merge branch 'lang/memory-census' into lang/foundations

selfhost/backend/emit_escape.ludic

@@ -20,6 +20,11 @@ const ES_FREED: int = 4                             # given back with free(): no
 
 var g_es_flag: []int = new []int
 var g_es_why: []Node = new []Node                   # per class: the statement that made it escape
+var g_es_own: []pointer = new []pointer             # per class: the state that holds it (25.5c's census)
+var g_es_gname: []pointer = new []pointer           # a class per state global, so each state is its own
+var g_es_gcls: []int = new []int
+var g_es_ok: []pointer = new []pointer              # file:line of a kept site -> the state that holds it
+var g_es_ov: []Node = new []Node
 var g_es_swhy: []Node = new []Node                  # per store edge: its statement
 var g_es_stmt: Node = null                          # the statement being walked
 var g_es_aok: int = 0                               # inside a statement under @alloc_ok
@@ -48,7 +53,7 @@ var g_es_lt: []pointer = new []pointer              # ... and their types, where
 var g_es_cur: int = -1
 var g_es_heap: int = -1                             # the one class for globals, states and the unknown
 
-function es_new(flags: int) -> int { push(g_es_flag, flags);  push(g_es_why, null);  return len(g_es_flag) - 1 }
+function es_new(flags: int) -> int { push(g_es_flag, flags);  push(g_es_why, null);  push(g_es_own, null);  return len(g_es_flag) - 1 }
 function es_flow(a: int, b: int) -> void { if a >= 0 and b >= 0 { push(g_es_ff, a);  push(g_es_ft, b) } }
 function es_store(v: int, t: int) -> void {
   if v < 0 { return }
@@ -174,6 +179,16 @@ function es_val(e: Node) -> int {
   if k == E_ID {
     let c = es_local(e.s)
     if c >= 0 { return c }
+    let g = find_global(e.s)
+    if g != null and is_state_ty(g.ty) {
+      var i = 0
+      while i < len(g_es_gname) { if (g_es_gname[i] == e.s) { return g_es_gcls[i] };  i += 1 }
+      let sc = es_new(ES_ESC | ES_HEAP)
+      g_es_own[sc] = g.ty
+      push(g_es_gname, e.s)
+      push(g_es_gcls, sc)
+      return sc
+    }
     return g_es_heap
   }
   if k == E_MEMBER { return es_val(e.a) }
@@ -248,9 +263,12 @@ function es_call(e: Node) -> int {
       es_args_walk(e)
       return es_site(e)
     }
-    if (nm == "keep") or (nm == "intern") {
+    if (nm == "keep") or (nm == "intern") {         # a heap copy on purpose: a site for the census's owner, never scratch
       es_args_walk(e)
-      return g_es_heap
+      let kc = es_site(e)
+      g_es_flag[kc] = g_es_flag[kc] | ES_ESC
+      g_es_site_aok[len(g_es_site_aok) - 1] = true   # deliberate: not a keep to report, nor a birth
+      return kc
     }
     if (nm == "push") and len(e.kids) >= 2 {
       let t = es_val(e.kids[0])
@@ -443,6 +461,27 @@ function es_solve() -> void {
       i += 1
     }
   }
+  # 25.5c: which state holds what - a container's owner flows forward, a stored value takes its
+  # target's, and what flowed into a value takes the value's; the first found stays
+  changed = true
+  while changed {
+    changed = false
+    var o = 0
+    while o < len(g_es_ff) {
+      let a = g_es_ff[o]
+      let b = g_es_ft[o]
+      if g_es_own[a] != null and g_es_own[b] == null { g_es_own[b] = g_es_own[a];  changed = true }
+      if g_es_own[b] != null and g_es_own[a] == null and (g_es_flag[a] & ES_ESC) != 0 { g_es_own[a] = g_es_own[b];  changed = true }
+      o += 1
+    }
+    o = 0
+    while o < len(g_es_sv) {
+      let v = g_es_sv[o]
+      let t = g_es_st[o]
+      if g_es_own[t] != null and g_es_own[v] == null { g_es_own[v] = g_es_own[t];  changed = true }
+      o += 1
+    }
+  }
   # a function that reaches Mem.frame spans frames: so does every caller
   changed = true
   while changed {
@@ -463,6 +502,7 @@ var g_es_esc_n: int = 0
 function escape_analyse() -> void {
   if g_es_done { return }
   g_es_done = true
+  ck_tab_init(g_es_ok, g_es_ov)
   g_es_heap = es_new(ES_ESC | ES_HEAP)
   ck_tab_init(g_es_fk, g_es_fv)
   var i = 0
@@ -476,7 +516,11 @@ function escape_analyse() -> void {
       push(g_es_fspans, d.kind == N_MAIN)
       push(g_es_fparam, len(g_es_flag))
       var p = 0
-      while p < len(d.kids) { es_new(ES_HEAP);  p += 1 }
+      while p < len(d.kids) {
+        let pc = es_new(ES_HEAP)
+        if d.kids[p].kind == N_PARAM and is_state_ty(d.kids[p].ty) { g_es_own[pc] = d.kids[p].ty }
+        p += 1
+      }
       push(g_es_fret, es_new(0))
     }
     i += 1
@@ -516,7 +560,14 @@ function escape_analyse() -> void {
     if c >= 0 and (g_es_flag[c] & ES_ESC) == 0 and not spans {
       n.uns = ES_SCRATCH
       g_es_local_n += 1
-    } else { g_es_esc_n += 1 }
+    } else {
+      g_es_esc_n += 1
+      if c >= 0 and g_es_own[c] != null and n.file != null {
+        let h = new Node
+        h.s = g_es_own[c]
+        ck_tab_put(g_es_ok, g_es_ov, `{n.file}:{itoa(n.line)}`, h)
+      }
+    }
     s += 1
   }
 }
@@ -578,3 +629,11 @@ function emit_keep(a: Val) -> Val {
   }
   return a
 }
+
+# the state that holds what a site makes, when the analysis ran and found one
+function es_owner_at(file: pointer, line: int) -> pointer {
+  if not g_es_done or file == null { return null }
+  let h = ck_tab_get(g_es_ok, g_es_ov, `{file}:{itoa(line)}`)
+  if h == null { return null }
+  return h.s
+}

selfhost/backend/emit_fence.ludic

@@ -11,6 +11,8 @@ var g_site_fn: []pointer = new []pointer       # per site: the function name's c
 var g_site_file: []pointer = new []pointer     # the file name's constant
 var g_site_line: []int = new []int
 var g_site_kind: []pointer = new []pointer     # the kind's constant
+var g_site_owner: []int = new []int            # 25.5c: the state that holds it (index + 1 into g_owner_names, 0: none)
+var g_owner_names: []pointer = new []pointer
 var g_cur_fn_name: pointer = "?"               # the function being emitted
 var g_site_fnc: pointer = null                 # its name's constant, made at its first site
 var g_site_filen: pointer = null               # the last file a site named, and its constant
@@ -38,6 +40,7 @@ var g_es_node: Node = null                     # the expression being emitted, w
 function fence_reset() -> void {
   g_site_fn = new []pointer;  g_site_file = new []pointer;  g_site_line = new []int;  g_site_kind = new []pointer
   g_site_kinds = new []pointer;  g_site_kindc = new []pointer
+  g_site_owner = new []int;  g_owner_names = new []pointer
   g_atexit_declared = false
   g_mzs_declared = false
   g_mmap_declared = false
@@ -45,6 +48,7 @@ function fence_reset() -> void {
   g_scan_roots = new []pointer
   g_cur_fn_name = "?";  g_site_fnc = null;  g_site_filen = null;  g_site_filec = null;  g_site_next = null
   push(g_site_fn, null);  push(g_site_file, null);  push(g_site_line, 0);  push(g_site_kind, null)   # site 0, named at the end
+  push(g_site_owner, 0)
 }
 
 # the function the next sites belong to (emit_fn, emit_system_fn)
@@ -53,6 +57,14 @@ function fence_enter(name: pointer) -> void {
   g_site_fnc = null
 }
 
+function fence_owner_index(own: pointer) -> int {
+  if own == null { return 0 }
+  var i = 0
+  while i < len(g_owner_names) { if (g_owner_names[i] == own) { return i + 1 };  i += 1 }
+  push(g_owner_names, own)
+  return len(g_owner_names)
+}
+
 function fence_kind_const(kind: pointer) -> pointer {
   var i = 0
   while i < len(g_site_kinds) { if (g_site_kinds[i] == kind) { return g_site_kindc[i] };  i += 1 }
@@ -77,6 +89,7 @@ function emit_site(kind: pointer) -> void {
   push(g_site_file, g_site_filec)
   push(g_site_line, g_err_line)
   push(g_site_kind, fence_kind_const(k))
+  push(g_site_owner, fence_owner_index(es_owner_at(file, g_err_line)))
   emit(`  store i32 {itoa(id)}, ptr @lp_site\n`)
 }
 
@@ -234,6 +247,16 @@ function emit_fence_runtime() -> void {
   emith(`@lp_site_stamp = global [{sn} x i64] zeroinitializer\n`)
   emith(`@lp_site_base = global [{sn} x i64] zeroinitializer\n`)
   emith(`@lp_site_scan = global [{sn} x i64] zeroinitializer\n`)
+  let owns = new []pointer
+  var w = 0
+  while w < n { push(owns, itoa(g_site_owner[w]));  w += 1 }
+  fence_table("@lp_site_owner", "i32", owns)
+  let onames = new []pointer
+  var q = 0
+  while q < len(g_owner_names) { push(onames, emit_str_const(g_owner_names[q]));  q += 1 }
+  if len(onames) == 0 { push(onames, "null") }
+  fence_table("@lp_owner_name", "ptr", onames)
+  emith(`@lp_nowners = global i32 {itoa(len(g_owner_names))}\n`)
   let roots = new []pointer
   var r = 0
   while r < len(g_scan_roots) { push(roots, `@g_{g_scan_roots[r]}`);  r += 1 }

selfhost/backend/emit_fence_ir.ludic

@@ -93,6 +93,7 @@ function emit_fence_globals() -> void {
   emith("@.lpf_exitscan = private unnamed_addr constant [15 x i8] c\"R3D_ALLOC_EXIT\\00\"\n")
   emith("@.lpf_shdr = private unnamed_addr constant [116 x i8] c\"alloc-scan: frame %lld - %lld bytes in %lld blocks made since tracking began are reachable from no global or state\\0A\\00\"\n")
   emith("@.lpf_srow = private unnamed_addr constant [25 x i8] c\"  %lld B  %s  %s:%d  %s\\0A\\00\"\n")
+  emith("@.lpf_cown = private unnamed_addr constant [49 x i8] c\"owner %s holds %lld (%+lld since judging began)\\0A\\00\"\n")
   emith("@.lpf_failing = private unnamed_addr constant [53 x i8] c\"alloc-fence: failing the run (R3D_ALLOC_FENCE=fail)\\0A\\00\"\n")
   emith("@.lpf_census = private unnamed_addr constant [17 x i8] c\"R3D_ALLOC_CENSUS\\00\"\n")
   emith("@.lpf_warmmax = private unnamed_addr constant [19 x i8] c\"R3D_ALLOC_WARM_MAX\\00\"\n")
@@ -1097,6 +1098,7 @@ function emit_fence_report() -> void {
   emith("  call i32 (ptr, ptr, ...) @fprintf(ptr %fp, ptr @.lpf_cvk, i64 %vd1, i64 %vpk)\n")
   emith("  %sn = load i32, ptr @lp_site_n\n")
   emith("  call void @lp_franked(ptr %fp, ptr @lp_site_base, i1 1, i32 %sn, i32 40)\n")
+  emith("  call void @lp_fowners(ptr %fp)\n")
   emith("  call i32 @fclose(ptr %fp)\n")
   emith("  br label %out\n")
   emith("out:\n")
@@ -1429,6 +1431,56 @@ function emit_fence_frame() -> void {
   emith("  call void @lp_funlock()\n")
   emith("  ret i64 %lost\n")
   emith("}\n")
+  emith("; 25.5c: the census by owner - what each state holds of what its sites made, and how much it grew\n")
+  emith("define internal void @lp_fowners(ptr %fp) {\n")
+  emith("entry:\n")
+  emith("  %no = load i32, ptr @lp_nowners\n")
+  emith("  %sn = load i32, ptr @lp_site_n\n")
+  emith("  br label %ol\n")
+  emith("ol:\n")
+  emith("  %o = phi i32 [ 1, %entry ], [ %o1, %onext ]\n")
+  emith("  %ogo = icmp ule i32 %o, %no\n")
+  emith("  br i1 %ogo, label %sl0, label %done\n")
+  emith("sl0:\n")
+  emith("  br label %sl\n")
+  emith("sl:\n")
+  emith("  %s = phi i32 [ 0, %sl0 ], [ %s1, %snext ]\n")
+  emith("  %live = phi i64 [ 0, %sl0 ], [ %live2, %snext ]\n")
+  emith("  %grew = phi i64 [ 0, %sl0 ], [ %grew2, %snext ]\n")
+  emith("  %sgo = icmp ult i32 %s, %sn\n")
+  emith("  br i1 %sgo, label %sb, label %say\n")
+  emith("sb:\n")
+  emith("  %op = getelementptr inbounds i32, ptr @lp_site_owner, i32 %s\n")
+  emith("  %ow = load i32, ptr %op\n")
+  emith("  %mine = icmp eq i32 %ow, %o\n")
+  emith("  %lp = getelementptr inbounds i64, ptr @lp_site_live, i32 %s\n")
+  emith("  %lv = load i64, ptr %lp\n")
+  emith("  %bp = getelementptr inbounds i64, ptr @lp_site_base, i32 %s\n")
+  emith("  %bv = load i64, ptr %bp\n")
+  emith("  %d = sub i64 %lv, %bv\n")
+  emith("  %la = select i1 %mine, i64 %lv, i64 0\n")
+  emith("  %da = select i1 %mine, i64 %d, i64 0\n")
+  emith("  %live2 = add i64 %live, %la\n")
+  emith("  %grew2 = add i64 %grew, %da\n")
+  emith("  br label %snext\n")
+  emith("snext:\n")
+  emith("  %s1 = add i32 %s, 1\n")
+  emith("  br label %sl\n")
+  emith("say:\n")
+  emith("  %any = icmp ne i64 %live, 0\n")
+  emith("  br i1 %any, label %print, label %onext\n")
+  emith("print:\n")
+  emith("  %oi = sub i32 %o, 1\n")
+  emith("  %np = getelementptr inbounds ptr, ptr @lp_owner_name, i32 %oi\n")
+  emith("  %nm = load ptr, ptr %np\n")
+  emith("  call i32 (ptr, ptr, ...) @fprintf(ptr %fp, ptr @.lpf_cown, ptr %nm, i64 %live, i64 %grew)\n")
+  emith("  br label %onext\n")
+  emith("onext:\n")
+  emith("  %o1 = add i32 %o, 1\n")
+  emith("  br label %ol\n")
+  emith("done:\n")
+  emith("  ret void\n")
+  emith("}\n")
   emith("define internal void @lp_fsettle_locked() {\n")
   emith("entry:\n")
   emith("  %n = load i32, ptr @lp_site_n\n")