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

examples/lang/alloc_fence_declared.ludic

@@ -0,0 +1,34 @@
+# alloc_fence_declared.ludic - what @alloc_ok covers is declared at run time too, in each form: a
+# function (and what it calls), one statement, and a statement inside a generic's body (every
+# instance). A frame that makes only declared memory is not judged, so the fence - failing by
+# default - lets the run through: `bad 0 kept 0`. Declared bytes are counted apart in the census.
+program AllocFenceDeclared {
+  property Rule { parts: []string = null }
+  property Memo { rules: []Rule = new []Rule, ints: []int = new []int }
+  function kept_push<T>(xs: []T, v: T) -> void {
+    @alloc_ok("a kept list: grows to the most it held")
+    push(xs, v)
+  }
+  @alloc_ok("a memo miss")
+  function split(s: string) -> []string {
+    let out = new []string
+    push(out, s[0 .. 1])
+    push(out, s[1 .. 2])
+    return out
+  }
+  function miss(m: Memo, f: int) -> void {
+    @alloc_ok("the memo keeps a rule per text")
+    let r = new Rule { parts: split(`ab{f}`) }
+    kept_push(m.rules, r)
+    kept_push(m.ints, f)
+  }
+  entry {
+    let m = new Memo
+    for f in 0 .. 900 {
+      if f > 650 and f % 25 == 0 { miss(m, f) }
+      Mem.frame()
+    }
+    let kept_now = Mem.kept()
+    print(`bad {Mem.bad_frames()} kept {kept_now}`)
+  }
+}

selfhost/backend/emit_fence.ludic

@@ -51,10 +51,13 @@ function fence_reset() -> void {
   push(g_site_owner, 0)
 }
 
-# the function the next sites belong to (emit_fn, emit_system_fn)
+# the function the next sites belong to (emit_fn, emit_system_fn); a LOCAL mark is honoured only
+# while emitting a function the escape analysis walked (a default's node is also emitted elsewhere)
+var g_es_walked: bool = false
 function fence_enter(name: pointer) -> void {
   g_cur_fn_name = name
   g_site_fnc = null
+  g_es_walked = g_es_done and (es_fn(name) >= 0 or str_starts(name, "@On("))
 }
 
 function fence_owner_index(own: pointer) -> int {
@@ -107,7 +110,7 @@ function fence_bind(rest: pointer) -> bool {
   else if str_starts(rest, "call ptr @lp_str_slice(") { emit_site("substring") }
   else if str_starts(rest, "call ptr @lp_text_") { emit_site("Text");  alloc = false }
   else { alloc = false }
-  if alloc and g_arena and g_es_node != null {
+  if alloc and g_arena and g_es_walked and g_es_node != null {
     emit("  store i8 1, ptr @lp_want\n")
     return true
   }
@@ -247,6 +250,7 @@ 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`)
+  emith(`@lp_site_dlive = 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 }

selfhost/backend/emit_fence_ir.ludic

@@ -90,6 +90,10 @@ function emit_fence_globals() -> void {
   emith("@.lpf_capfail = private unnamed_addr constant [78 x i8] c\"alloc-fence: failing the run (R3D_ALLOC_FENCE=fail): a capacity is a promise\\0A\\00\"\n")
   emith("@.lpf_ccap = private unnamed_addr constant [56 x i8] c\"overflows %lld (a list past its @max, or a table full)\\0A\\00\"\n")
   emith("@.lpf_scan = private unnamed_addr constant [15 x i8] c\"R3D_ALLOC_SCAN\\00\"\n")
+  emith("@.lpf_scantop = private unnamed_addr constant [19 x i8] c\"R3D_ALLOC_SCAN_TOP\\00\"\n")
+  emith("@.lpf_scanfile = private unnamed_addr constant [20 x i8] c\"R3D_ALLOC_SCAN_FILE\\00\"\n")
+  emith("@.lpf_sfrow = private unnamed_addr constant [18 x i8] c\"%lld %s %s:%d %s\\0A\\00\"\n")
+  emith("@.lpf_a = private unnamed_addr constant [2 x i8] c\"a\\00\"\n")
   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")
@@ -426,6 +430,17 @@ function emit_fence_table() -> void {
   emith("out:\n")
   emith("  ret void\n")
   emith("}\n")
+  emith("define internal void @lp_fsite_dadd(i64 %s, i64 %n) {\n")
+  emith("entry:\n")
+  emith("  %sp = getelementptr inbounds i64, ptr @lp_site_dlive, i64 %s\n")
+  emith("  %v = load i64, ptr %sp\n")
+  emith("  %v1 = add i64 %v, %n\n")
+  emith("  store i64 %v1, ptr %sp\n")
+  emith("  %dl = load i64, ptr @lp_dlive\n")
+  emith("  %dl1 = add i64 %dl, %n\n")
+  emith("  store i64 %dl1, ptr @lp_dlive\n")
+  emith("  ret void\n")
+  emith("}\n")
   emith("define internal void @lp_fsite_add(i64 %s, i64 %n) {\n")
   emith("entry:\n")
   emith("  %sp = getelementptr inbounds i64, ptr @lp_site_live, i64 %s\n")
@@ -589,13 +604,16 @@ function emit_fence_table() -> void {
   emith("  %dn = and i64 %dold, 549755813887\n")
   emith("  %ds = lshr i64 %dold, 40\n")
   emith("  %dneg = sub i64 0, %dn\n")
-  emith("  call void @lp_fsite_add(i64 %ds, i64 %dneg)\n")
   emith("  %dwd = and i64 %dold, 549755813888\n")
   emith("  %dwas = icmp ne i64 %dwd, 0\n")
-  emith("  %ddl = load i64, ptr @lp_dlive\n")
+  emith("  br i1 %dwas, label %ddecl, label %dund\n")
-  emith("  %ddsub = select i1 %dwas, i64 %dn, i64 0\n")
+  emith("ddecl:\n")
-  emith("  %ddl1 = sub i64 %ddl, %ddsub\n")
+  emith("  call void @lp_fsite_dadd(i64 %ds, i64 %dneg)\n")
-  emith("  store i64 %ddl1, ptr @lp_dlive\n")
+  emith("  br label %dcount\n")
+  emith("dund:\n")
+  emith("  call void @lp_fsite_add(i64 %ds, i64 %dneg)\n")
+  emith("  br label %dcount\n")
+  emith("dcount:\n")
   emith("  %dtn = load i64, ptr @lp_tabn\n")
   emith("  %dtn1 = sub i64 %dtn, 1\n")
   emith("  store i64 %dtn1, ptr @lp_tabn\n")
@@ -613,16 +631,17 @@ function emit_fence_table() -> void {
   emith("  %dbit = select i1 %isdecl, i64 549755813888, i64 0\n")
   emith("  %v = or i64 %v0, %dbit\n")
   emith("  store i64 %v, ptr %ev\n")
-  emith("  %dl = load i64, ptr @lp_dlive\n")
-  emith("  %dadd = select i1 %isdecl, i64 %n, i64 0\n")
-  emith("  %dl1 = add i64 %dl, %dadd\n")
-  emith("  store i64 %dl1, ptr @lp_dlive\n")
   emith("  %tn = load i64, ptr @lp_tabn\n")
   emith("  %tn1 = add i64 %tn, 1\n")
   emith("  store i64 %tn1, ptr @lp_tabn\n")
   emith("  %md = load i64, ptr @lp_made\n")
   emith("  %md1 = add i64 %md, 1\n")
   emith("  store i64 %md1, ptr @lp_made\n")
+  emith("  br i1 %isdecl, label %pdecl, label %pund\n")
+  emith("pdecl:\n")
+  emith("  call void @lp_fsite_dadd(i64 %s64, i64 %n)\n")
+  emith("  br label %unlock\n")
+  emith("pund:\n")
   emith("  call void @lp_fsite_add(i64 %s64, i64 %n)\n")
   emith("  call void @lp_fcallers(i64 %s64)\n")
   emith("  br label %unlock\n")
@@ -671,13 +690,16 @@ function emit_fence_table() -> void {
   emith("  %n = and i64 %v, 549755813887\n")
   emith("  %s = lshr i64 %v, 40\n")
   emith("  %neg = sub i64 0, %n\n")
-  emith("  call void @lp_fsite_add(i64 %s, i64 %neg)\n")
   emith("  %wd = and i64 %v, 549755813888\n")
   emith("  %wasdecl = icmp ne i64 %wd, 0\n")
-  emith("  %dl = load i64, ptr @lp_dlive\n")
+  emith("  br i1 %wasdecl, label %fdecl, label %fund\n")
-  emith("  %dsub = select i1 %wasdecl, i64 %n, i64 0\n")
+  emith("fdecl:\n")
-  emith("  %dl1 = sub i64 %dl, %dsub\n")
+  emith("  call void @lp_fsite_dadd(i64 %s, i64 %neg)\n")
-  emith("  store i64 %dl1, ptr @lp_dlive\n")
+  emith("  br label %fcount\n")
+  emith("fund:\n")
+  emith("  call void @lp_fsite_add(i64 %s, i64 %neg)\n")
+  emith("  br label %fcount\n")
+  emith("fcount:\n")
   emith("  %fr = load i64, ptr @lp_freed\n")
   emith("  %fr1 = add i64 %fr, 1\n")
   emith("  store i64 %fr1, ptr @lp_freed\n")
@@ -686,8 +708,8 @@ function emit_fence_table() -> void {
   emith("  store i64 %tn1, ptr @lp_tabn\n")
   emith("  br label %sh\n")
   emith("sh:\n")
-  emith("  %hole = phi i64 [ %im, %found ], [ %hole, %sh_skip ], [ %j, %sh_move ]\n")
+  emith("  %hole = phi i64 [ %im, %fcount ], [ %hole, %sh_skip ], [ %j, %sh_move ]\n")
-  emith("  %jp = phi i64 [ %im, %found ], [ %j, %sh_skip ], [ %j, %sh_move ]\n")
+  emith("  %jp = phi i64 [ %im, %fcount ], [ %j, %sh_skip ], [ %j, %sh_move ]\n")
   emith("  %j0 = add i64 %jp, 1\n")
   emith("  %j = and i64 %j0, %mask\n")
   emith("  %ej = getelementptr inbounds [2 x i64], ptr %tab, i64 %j\n")
@@ -910,11 +932,7 @@ function emit_fence_control() -> void {
   emith("  %sl = load i64, ptr @lp_slive\n")
   emith("  %pr = load i64, ptr @lp_pre\n")
   emith("  %sp = load i64, ptr @lp_spre\n")
-  emith("  %a0 = sub i64 %lv, %sl\n")
+  emith("  %a = sub i64 %lv, %sl\n")
-  emith("  %dlk = load i64, ptr @lp_dlive\n")
-  emith("  %sdl = load i64, ptr @lp_sdlive\n")
-  emith("  %ddk = sub i64 %dlk, %sdl\n")
-  emith("  %a = sub i64 %a0, %ddk\n")
   emith("  %b = sub i64 %pr, %sp\n")
   emith("  %k = sub i64 %a, %b\n")
   emith("  call void @lp_funlock()\n")
@@ -1398,14 +1416,20 @@ function emit_fence_frame() -> void {
   emith("  store i64 %lost, ptr @lp_scan_bytes\n")
   emith("  %f = load i64, ptr @lp_frame\n")
   emith("  call i32 (i32, ptr, ...) @dprintf(i32 2, ptr @.lpf_shdr, i64 %f, i64 %lost, i64 %lostn)\n")
-  emith("  br label %rows\n")
+  emith("  %top = call i64 @lp_fenv(ptr @.lpf_scantop, i64 24)\n")
+  emith("  %top32 = trunc i64 %top to i32\n")
+  emith("  call void @lp_franked_vals(ptr @lp_site_scan, i32 %sn, i32 %top32)\n")
+  emith("  %sfp = call ptr @getenv(ptr @.lpf_scanfile)\n")
+  emith("  %hasf = icmp ne ptr %sfp, null\n")
+  emith("  br i1 %hasf, label %tofile, label %fin\n")
+  emith("tofile:\n")
+  emith("  %fh = call ptr @fopen(ptr %sfp, ptr @.lpf_a)\n")
+  emith("  %fok = icmp ne ptr %fh, null\n")
+  emith("  br i1 %fok, label %rows, label %fin\n")
   emith("rows:\n")
-  emith("  %ri2 = phi i32 [ 0, %report ], [ %ri3, %rnext ]\n")
+  emith("  %ri2 = phi i32 [ 0, %tofile ], [ %ri3, %rnext ]\n")
-  emith("  %shown = phi i32 [ 0, %report ], [ %shown2, %rnext ]\n")
   emith("  %more = icmp ult i32 %ri2, %sn\n")
-  emith("  %room = icmp ult i32 %shown, 24\n")
+  emith("  br i1 %more, label %row, label %close\n")
-  emith("  %rgo2 = and i1 %more, %room\n")
-  emith("  br i1 %rgo2, label %row, label %fin\n")
   emith("row:\n")
   emith("  %rsp = getelementptr inbounds i64, ptr @lp_site_scan, i32 %ri2\n")
   emith("  %rv = load i64, ptr %rsp\n")
@@ -1420,13 +1444,14 @@ function emit_fence_frame() -> void {
   emith("  %ln = load i32, ptr %lnp\n")
   emith("  %kdp = getelementptr inbounds ptr, ptr @lp_site_kind, i32 %ri2\n")
   emith("  %kd = load ptr, ptr %kdp\n")
-  emith("  call i32 (i32, ptr, ...) @dprintf(i32 2, ptr @.lpf_srow, i64 %rv, ptr %fn, ptr %fl, i32 %ln, ptr %kd)\n")
+  emith("  call i32 (ptr, ptr, ...) @fprintf(ptr %fh, ptr @.lpf_sfrow, i64 %rv, ptr %fn, ptr %fl, i32 %ln, ptr %kd)\n")
   emith("  br label %rnext\n")
   emith("rnext:\n")
-  emith("  %inc = phi i32 [ 0, %row ], [ 1, %say ]\n")
-  emith("  %shown2 = add i32 %shown, %inc\n")
   emith("  %ri3 = add i32 %ri2, 1\n")
   emith("  br label %rows\n")
+  emith("close:\n")
+  emith("  call i32 @fclose(ptr %fh)\n")
+  emith("  br label %fin\n")
   emith("fin:\n")
   emith("  call void @lp_funlock()\n")
   emith("  ret i64 %lost\n")
@@ -1481,6 +1506,50 @@ function emit_fence_frame() -> void {
   emith("done:\n")
   emith("  ret void\n")
   emith("}\n")
+  emith("; the largest `rows` of a per-site array, largest first, to stderr (the scan's)\n")
+  emith("define internal void @lp_franked_vals(ptr %vals, i32 %cnt, i32 %rows) {\n")
+  emith("entry:\n")
+  emith("  br label %pass\n")
+  emith("pass:\n")
+  emith("  %row = phi i32 [ 0, %entry ], [ %row1, %show ]\n")
+  emith("  %pb = phi i64 [ 9223372036854775807, %entry ], [ %bb0, %show ]\n")
+  emith("  %ps = phi i32 [ -1, %entry ], [ %bs0, %show ]\n")
+  emith("  %more = icmp ult i32 %row, %rows\n")
+  emith("  br i1 %more, label %scan, label %tail\n")
+  emith("scan:\n")
+  emith("  br label %loop\n")
+  emith("loop:\n")
+  emith("  %i = phi i32 [ 0, %scan ], [ %i1, %body ]\n")
+  emith("  %bb0 = phi i64 [ 0, %scan ], [ %bb1, %body ]\n")
+  emith("  %bs0 = phi i32 [ -1, %scan ], [ %bs1, %body ]\n")
+  emith("  %go = icmp ult i32 %i, %cnt\n")
+  emith("  br i1 %go, label %body, label %done\n")
+  emith("body:\n")
+  emith("  %vp = getelementptr inbounds i64, ptr %vals, i32 %i\n")
+  emith("  %d = load i64, ptr %vp\n")
+  emith("  %pos = icmp sgt i64 %d, 0\n")
+  emith("  %lt = icmp slt i64 %d, %pb\n")
+  emith("  %eqb = icmp eq i64 %d, %pb\n")
+  emith("  %gts = icmp sgt i32 %i, %ps\n")
+  emith("  %tie = and i1 %eqb, %gts\n")
+  emith("  %below = or i1 %lt, %tie\n")
+  emith("  %gtb = icmp sgt i64 %d, %bb0\n")
+  emith("  %c1 = and i1 %pos, %below\n")
+  emith("  %take = and i1 %c1, %gtb\n")
+  emith("  %bb1 = select i1 %take, i64 %d, i64 %bb0\n")
+  emith("  %bs1 = select i1 %take, i32 %i, i32 %bs0\n")
+  emith("  %i1 = add i32 %i, 1\n")
+  emith("  br label %loop\n")
+  emith("done:\n")
+  emith("  %found = icmp sge i32 %bs0, 0\n")
+  emith("  br i1 %found, label %show, label %tail\n")
+  emith("show:\n")
+  emith("  call void @lp_fsite_row(ptr null, i32 2, i64 %bb0, i32 %bs0)\n")
+  emith("  %row1 = add i32 %row, 1\n")
+  emith("  br label %pass\n")
+  emith("tail:\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")
@@ -1549,11 +1618,7 @@ function emit_fence_frame() -> void {
   emith("  %ml = load i64, ptr @lp_mlive\n")
   emith("  %pr = load i64, ptr @lp_pre\n")
   emith("  %mp = load i64, ptr @lp_mpre\n")
-  emith("  %a0 = sub i64 %lv, %ml\n")
+  emith("  %a = sub i64 %lv, %ml\n")
-  emith("  %dln = load i64, ptr @lp_dlive\n")
-  emith("  %dlmk = load i64, ptr @lp_mdlive\n")
-  emith("  %dd = sub i64 %dln, %dlmk\n")
-  emith("  %a = sub i64 %a0, %dd\n")
   emith("  %b = sub i64 %pr, %mp\n")
   emith("  %kept = sub i64 %a, %b\n")
   emith("  %bad = icmp sgt i64 %kept, 0\n")

tools/ludic-cli/test.ludic

@@ -1132,6 +1132,7 @@ function cmd_dev_test() -> int {
   feat_case("lang/string_temps", "", "1 2 3 4 5 6 7 grew 0", "string_temps.ludic (a concatenation's pieces, a template's holes and a compared side are freed once used; a kept one is not)")
   feat_case("lang/json_saves", "", "1 2 3 saves grew 0", "json_saves.ludic (Json.write_file saves through a kept buffer: the text Json.encode gives, 1000 saves keep nothing)")
   feat_case("lang/alloc_fence", "", "frames 300 kept 0 bad 0", "alloc_fence.ludic (25.1: a frame that makes only what it frees or reuses keeps nothing, and the fence passes it)")
+  feat_case("lang/alloc_fence_declared", "", "bad 0 kept 0", "alloc_fence_declared.ludic (25.1: @alloc_ok on a function, a statement and a generic's statement is declared at run time; the failing fence lets it through)")
   alloc_fence_leak_case()
   alloc_fence_auto_case()
   arena_pool_case()