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

# Conflicts:
#	selfhost/ludicc.seed.ll
#	selfhost/ludicc.win.seed.ll

examples/lang/alloc_fence_sites.ludic

@@ -0,0 +1,17 @@
+# alloc_fence_sites.ludic - 25.1: each block is charged to the line that made it. Two lines take turns
+# keeping memory, one through a runtime helper (Text.repeat) and one a record; every frame is judged
+# (R3D_ALLOC_FENCE=warn R3D_ALLOC_WARM_MAX=10) and each report names its own line - a helper once took
+# the site of whatever had allocated last
+program AllocFenceSites {
+  property Box { v: int = 0 }
+  property Keep { texts: []string = new []string, boxes: []Box = new []Box }
+  entry {
+    let k = new Keep
+    for f in 0 .. 60 {
+      if f % 2 == 0 { push(k.texts, Text.repeat("ab", 12)) }
+      else { push(k.boxes, new Box { v: f }) }
+      Mem.frame()
+    }
+    print(`texts {len(k.texts)} boxes {len(k.boxes)}`)
+  }
+}

selfhost/backend/emit_fence.ludic

@@ -96,10 +96,15 @@ function emit_site(kind: pointer) -> void {
   emit(`  store i32 {itoa(id)}, ptr @lp_site\n`)
 }
 
-# emit_bind's hook: a call that allocates gets a site first, its kind read off the callee; when the
+# emit_bind's hook: a call into the runtime gets a site first, its kind read off the callee - what the
+# callee allocates, however many blocks and through whichever helpers, is that line's - and
+# g_site_reset puts site 0 back once it returns, so nothing after it is charged to it. When the
 # expression being emitted is a LOCAL site (25.3) it also raises @lp_want for that one call
+var g_site_reset: bool = false
 function fence_bind(rest: pointer) -> bool {
+  g_site_reset = false
   if not str_starts(rest, "call ptr @lp_") { return false }
+  g_site_reset = true
   var alloc = true
   if str_starts(rest, "call ptr @lp_malloc(") { emit_site("alloc") }
   else if str_starts(rest, "call ptr @lp_calloc(") { emit_site("slice data") }
@@ -109,7 +114,11 @@ function fence_bind(rest: pointer) -> bool {
   else if str_starts(rest, "call ptr @lp_fp_str(") { emit_site("string(x)") }
   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 }
+  else if str_starts(rest, "call ptr @lp_intern(") { emit_site("intern");  alloc = false }
+  else {
+    emit_site(fence_callee(rest))                  # any other runtime helper: named by the callee
+    alloc = false
+  }
   if alloc and g_arena and g_es_walked and g_es_node != null {
     emit("  store i8 1, ptr @lp_want\n")
     return true
@@ -117,6 +126,14 @@ function fence_bind(rest: pointer) -> bool {
   return false
 }
 
+# "call ptr @lp_fs_read(ptr %a)" -> "fs_read"
+function fence_callee(rest: pointer) -> pointer {
+  let at = len("call ptr @lp_")
+  var e = at
+  while e < len(rest) and not (rest[e] == '(') { e += 1 }
+  return rest[at..e]
+}
+
 function fence_int(s: pointer) -> int {
   var n = 0
   var neg = false
@@ -227,8 +244,8 @@ function emit_fence_runtime() -> void {
   emit_fence_control()
   emit_fence_report()
   emit_fence_frame()
-  let unknown = emit_str_const("?")
-  g_site_fn[0] = unknown;  g_site_file[0] = unknown;  g_site_kind[0] = unknown
+  # site 0 is what allocates with no site of its own: every sited call puts it back when it returns
+  g_site_fn[0] = emit_str_const("(runtime)");  g_site_file[0] = emit_str_const("(no site)");  g_site_kind[0] = emit_str_const("unsited")
   let n = len(g_site_line)
   let sn = itoa(n)
   var dflt = itoa(g_fence_mode)

selfhost/backend/emit_intrin.ludic

@@ -22,6 +22,7 @@ function emit_bind(rest: pointer) -> pointer {
   let r = nreg()
   emit("  ");  emit(r);  emit(" = ");  emit(rest);  emit("\n")
   if want { emit("  store i8 0, ptr @lp_want\n") }
+  if g_site_reset { emit("  store i32 0, ptr @lp_site\n");  g_site_reset = false }
   return r
 }
 

selfhost/backend/game/emit_ecs.ludic

@@ -200,7 +200,8 @@ function emit_ecs_grow() -> void {
 function emit_grow_store(store: pointer, esz: pointer, k: int) -> void {
   let n = itoa(k)
   emit(`  %gp{n} = load ptr, ptr @{store}\n  %gb{n} = mul i64 %nc64, {esz}\n  %gr{n} = add i64 %gb{n}, 8\n`)
-  emit(`  %gn{n} = call ptr @lp_realloc(ptr %gp{n}, i64 %gr{n})\n  %go{n} = mul i64 %cap64, {esz}\n`)
+  emit_site("ecs store grow")
+  emit(`  %gn{n} = call ptr @lp_realloc(ptr %gp{n}, i64 %gr{n})\n  store i32 0, ptr @lp_site\n  %go{n} = mul i64 %cap64, {esz}\n`)
   emit(`  %gt{n} = getelementptr i8, ptr %gn{n}, i64 %go{n}\n  %gz{n} = sub i64 %gr{n}, %go{n}\n`)
   emit(`  %gm{n} = call ptr @memset(ptr %gt{n}, i32 0, i64 %gz{n})\n  store ptr %gn{n}, ptr @{store}\n`)
 }
@@ -218,7 +219,8 @@ function emit_grow_dyn() -> void {
 
 function emit_grow_slot(table: pointer, esz: pointer, t: pointer) -> void {
   emit(`  %d{t}p = getelementptr inbounds [32 x ptr], ptr @{table}, i32 0, i32 %di\n  %d{t}o = load ptr, ptr %d{t}p\n`)
-  emit(`  %d{t}b = mul i64 %nc64, {esz}\n  %d{t}r = add i64 %d{t}b, 8\n  %d{t}n = call ptr @lp_realloc(ptr %d{t}o, i64 %d{t}r)\n`)
+  emit_site("ecs mod store grow")
+  emit(`  %d{t}b = mul i64 %nc64, {esz}\n  %d{t}r = add i64 %d{t}b, 8\n  %d{t}n = call ptr @lp_realloc(ptr %d{t}o, i64 %d{t}r)\n  store i32 0, ptr @lp_site\n`)
   emit(`  %d{t}f = mul i64 %cap64, {esz}\n  %d{t}t = getelementptr i8, ptr %d{t}n, i64 %d{t}f\n  %d{t}z = sub i64 %d{t}r, %d{t}f\n`)
   emit(`  %d{t}m = call ptr @memset(ptr %d{t}t, i32 0, i64 %d{t}z)\n  store ptr %d{t}n, ptr %d{t}p\n`)
 }

selfhost/backend/game/emit_world.ludic

@@ -205,9 +205,11 @@ function emit_world_table() -> void {
   emit("define i32 @ludic_register_prop(ptr %name, i32 %nfields) {\nentry:\n")
   emit("  %dc = load i32, ptr @dyn_count\n  %full = icmp slt i32 %dc, 32\n  br i1 %full, label %do, label %rej\n")
   emit("do:\n  %rcap = load i32, ptr @L_cap\n  %nf4 = mul i32 %nfields, 4\n  %sz = mul i32 %nf4, %rcap\n  %szl = sext i32 %sz to i64\n")
+  emit_site("ecs mod store")
   emit("  %buf = call ptr @lp_malloc(i64 %szl)\n  call ptr @memset(ptr %buf, i32 0, i64 %szl)\n")
   emit("  %sp = getelementptr inbounds [32 x ptr], ptr @dynS, i32 0, i32 %dc\n  store ptr %buf, ptr %sp\n")
-  emit("  %hcap = sext i32 %rcap to i64\n  %hbuf = call ptr @lp_malloc(i64 %hcap)\n  call ptr @memset(ptr %hbuf, i32 0, i64 %hcap)\n")
+  emit_site("ecs mod flags")
+  emit("  %hcap = sext i32 %rcap to i64\n  %hbuf = call ptr @lp_malloc(i64 %hcap)\n  store i32 0, ptr @lp_site\n  call ptr @memset(ptr %hbuf, i32 0, i64 %hcap)\n")
   emit("  %hp = getelementptr inbounds [32 x ptr], ptr @dynH, i32 0, i32 %dc\n  store ptr %hbuf, ptr %hp\n")
   emit("  %fp = getelementptr inbounds [32 x i32], ptr @dynF, i32 0, i32 %dc\n  store i32 %nfields, ptr %fp\n")
   emit("  %np = getelementptr inbounds [32 x ptr], ptr @dynName, i32 0, i32 %dc\n  store ptr %name, ptr %np\n")

tools/ludic-cli/test.ludic

@@ -812,6 +812,18 @@ function alloc_fence_rewarm_case() -> void {
   if (rc == 86) and (head == "alloc-fence: frame 3000 kept +16 B (1 made, 0 freed)") { ok(lbl) } else { bad2(lbl, `rc={string(rc)} head=[{head}]`) }
 }
 
+function alloc_fence_sites_case() -> void {
+  let lbl = "alloc_fence_sites.ludic (two lines take turns keeping memory, one through a runtime helper; each report charges its own line, never the one that allocated last)"
+  let b = `{tmp_dir()}/e_alloc_fence_sites`
+  if not game_build_ok("bin/ludicc", "examples/lang/alloc_fence_sites.ludic", b) { bad2(lbl, "did not build"); return }
+  let e = `{tmp_dir()}/afs.err`
+  sh(`R3D_ALLOC_FENCE=warn R3D_ALLOC_WARM_MAX=10 {b} < /dev/null > /dev/null 2>{e}`)
+  let texts = capture_line(`grep -c '+32 B  entry  examples/lang/alloc_fence_sites.ludic:11  str_repeat' {e}`)
+  let boxes = capture_line(`grep -c '+16 B  entry  examples/lang/alloc_fence_sites.ludic:12  new Box' {e}`)
+  let wrong = capture_line(`grep -c '+32 B  entry  examples/lang/alloc_fence_sites.ludic:12' {e}`)
+  if (texts == "25") and (boxes == "25") and (wrong == "0") { ok(lbl) } else { bad2(lbl, `texts={texts} boxes={boxes} charged-to-the-box-line={wrong}`) }
+}
+
 function alloc_fence_leak_case() -> void {
   let lbl = "alloc_fence_leak.ludic (a frame that keeps a record fails the run with exit 86 and names its line; count mode runs on)"
   let b = `{tmp_dir()}/e_alloc_fence_leak`
@@ -1176,6 +1188,7 @@ function cmd_dev_test() -> int {
   alloc_fence_leak_case()
   alloc_fence_unbounded_case()
   alloc_fence_rewarm_case()
+  alloc_fence_sites_case()
   alloc_fence_auto_case()
   arena_pool_case()
   arena_fnval_case()