ludic/selfhost/backend/emit_new.ludic

# emit_new.ludic — heap construction and slice operations: `new S`, `new []T`,
# push(slice, v) and len(slice). Slices are a { data, len, cap } header the
# holder points at, so growth is visible to every holder.

function emit_sizeof(llt: pointer) -> pointer {
  let p = emit_bind(`getelementptr {llt}, ptr null, i32 1`)
  return emit_bind(`ptrtoint ptr {p} to i64`)
}

# the value expression a `new T { ... }` record supplies for field `fname`,
# or null when the record omits it (so the field keeps its declared default).
function rec_field(rec: Node, fname: pointer) -> Node {
  if (rec == null) { return null }
  var i = 0
  while i < len(rec.kids) {
    let fi = rec.kids[i]
    if (fi.s == fname) { return fi.a }
    i += 1
  }
  return null
}

# `new T` / `new T { field: value, ... }` — allocate a record and seed each
# field: a value from the override record if given, else the field's declared
# default. `rec` is the E_REC of overrides (or null for the bare `new T`).
# `into`: a record to fill in place of a fresh one (a dispatch's, kept by the action queue)
function emit_new_struct(name: pointer, rec: Node, into: Node) -> Val {
  let s = layout_node(name)                     # a struct or a property — same shape
  if (s == null) and port_find(name) >= 0 { perr(`{name} is a port: it is filled once with 'bind {name} {{ ... }}' where the program is put together, not made with new`) }
  if (s == null) { perr(`unknown record type {name} in new`) }
  vis_check(s, name)
  let lty = layout_ty(name)
  let sz = emit_sizeof(lty)
  var obj = ""
  if into != null { obj = emit_expr(into).code } else { g_site_next = `new {name}`;  obj = emit_bind(`call ptr @lp_malloc(i64 {sz})`) }
  var f = 0
  while f < len(s.kids) {
    let fd = s.kids[f]
    let addr = nreg()
    emit("  ");  emit(addr);  emit(" = getelementptr inbounds ");  emit(lty)
    emit(", ptr ");  emit(obj);  emit(", i32 0, i32 ");  emit(itoa(f));  emit("\n")
    let lt = llty(fd.ty)
    var v = zero_of(lt)
    if (fd.a != null) { let dv = emit_expr(fd.a);  v = coerce_code(dv, fd.ty) }
    let ov = rec_field(rec, fd.s)               # explicit override wins over the default
    if (ov != null) { let dv = emit_expr(ov);  v = coerce_code(dv, fd.ty) }
    emit("  store ");  emit(lt);  emit(" ");  emit(v);  emit(", ptr ");  emit(addr);  emit("\n")
    f += 1
  }
  return val(obj, name)
}

function emit_new_slice(ty: pointer) -> Val {
  let sz = emit_sizeof("%LSlice")
  g_site_next = `new {ty}`
  let h = emit_bind(`call ptr @lp_malloc(i64 {sz})`)
  let d0 = nreg();  emit("  ");  emit(d0);  emit(" = getelementptr inbounds %LSlice, ptr ");  emit(h);  emit(", i32 0, i32 0\n")
  emit("  store ptr null, ptr ");  emit(d0);  emit("\n")
  let d1 = nreg();  emit("  ");  emit(d1);  emit(" = getelementptr inbounds %LSlice, ptr ");  emit(h);  emit(", i32 0, i32 1\n")
  emit("  store i32 0, ptr ");  emit(d1);  emit("\n")
  let d2 = nreg();  emit("  ");  emit(d2);  emit(" = getelementptr inbounds %LSlice, ptr ");  emit(h);  emit(", i32 0, i32 2\n")
  emit("  store i32 0, ptr ");  emit(d2);  emit("\n")
  return val(h, ty)
}

# words(n), floats(n), doubles(n): a slice of n zeroed elements, its length n (L7)
function emit_sized_slice(el: pointer, n: Val) -> Val {
  let h = emit_new_slice("[]" + el)
  let esz = emit_sizeof(llty(el))
  let nn = emit_bind(`zext i32 {n.code} to i64`)
  let data = emit_bind(`call ptr @lp_calloc(i64 {nn}, i64 {esz})`)
  emit(`  store ptr {data}, ptr {slice_field(h.code, 0)}\n`)
  emit(`  store i32 {n.code}, ptr {slice_field(h.code, 1)}\n`)
  emit(`  store i32 {n.code}, ptr {slice_field(h.code, 2)}\n`)
  return h
}
# the file a runtime error names: the one the expression is written in, not the program's own
function src_name_of(e: Node) -> pointer {
  if e == null or e.file == null { return g_src_name }
  return e.file
}
function emit_view(e: Node) -> Val {
  let xs = emit_expr(e.kids[0])
  if not is_slice_ty(xs.ty) { perr(`view takes a slice, and this is {xs.ty}`) }
  let st = emit_expr(e.kids[1])
  let ct = emit_expr(e.kids[2])
  let el = slice_elem(xs.ty)
  let ln = emit_bind(`load i32, ptr {slice_field(xs.code, 1)}`)
  let endv = emit_bind(`add i32 {st.code}, {ct.code}`)
  let ok1 = emit_bind(`icmp ule i32 {endv}, {ln}`)
  let ok2 = emit_bind(`icmp sge i32 {st.code}, 0`)
  let ok3 = emit_bind(`icmp sge i32 {ct.code}, 0`)
  let ok12 = emit_bind(`and i1 {ok1}, {ok2}`)
  let ok = emit_bind(`and i1 {ok12}, {ok3}`)
  let lok = lbl("vwok")
  let lbad = lbl("vwbad")
  emit(`  br i1 {ok}, label %{lok}, label %{lbad}\n`)
  emit(`{lbad}:\n`)
  g_uses_bounds = true
  let bmsg = emit_str_const(`{src_name_of(e)}:{itoa(e.line)}: view past the end: from `)
  let bse = emit_bind(stdstream_rhs(2))
  emit(`  call i32 (ptr, ptr, ...) @fprintf(ptr {bse}, ptr @.fmt_bounds, ptr {bmsg}, i32 {endv}, i32 {ln})\n`)
  emit("  call void @exit(i32 1)\n  unreachable\n")
  emit(`{lok}:\n`)
  let d0 = emit_bind(`load ptr, ptr {slice_field(xs.code, 0)}`)
  let d1 = emit_bind(`getelementptr inbounds {llty(el)}, ptr {d0}, i32 {st.code}`)
  let h = emit_new_slice(xs.ty)
  emit(`  store ptr {d1}, ptr {slice_field(h.code, 0)}\n`)
  emit(`  store i32 {ct.code}, ptr {slice_field(h.code, 1)}\n`)
  emit(`  store i32 {ct.code}, ptr {slice_field(h.code, 2)}\n`)
  return h
}
# an expression that a raw-memory intrinsic reads as an address: a slice gives its elements (L7)
function raw_expr(n: Node) -> Val {
  let v = emit_expr(n)
  if is_slice_ty(v.ty) { return val(emit_bind(`load ptr, ptr {slice_field(v.code, 0)}`), "pointer") }
  return v
}
function slice_field(h: pointer, i: int) -> pointer {
  let r = nreg()
  emit("  ");  emit(r);  emit(" = getelementptr inbounds %LSlice, ptr ");  emit(h)
  emit(", i32 0, i32 ");  emit(itoa(i));  emit("\n")
  return r
}

function emit_len(e: Node) -> Val {
  let s = emit_expr(e.kids[0])
  if is_slice_ty(s.ty) {                          # a slice: read its header length
    let lp = slice_field(s.code, 1)
    return val(emit_bind(`load i32, ptr {lp}`), "int")
  }
  let r = emit_bind(`call i64 @strlen(ptr {s.code})`)   # a string: byte length
  return val(emit_bind(`trunc i64 {r} to i32`), "int")
}

function emit_push(e: Node) -> Val {
  let s = emit_expr(e.kids[0])
  let v = emit_expr(e.kids[1])
  g_push_cap = fence_cap_of(e.kids[0])            # 25.5a: a list declared @max(n) says when it grows past n
  let capname = g_push_capname
  emit_push_into(s.code, llty(slice_elem(s.ty)), v)
  g_push_capname = capname
  return val("0", "void")
}

# `[a, b, c]` — a fresh slice holding the elements in order. The element type
# is the first element's; an empty literal has none, so it is spelled `new []T`.
function emit_list(e: Node) -> Val {
  if len(e.kids) == 0 { perr("an empty list literal has no element type: write `new []T` instead") }
  let first = emit_list_elem(e.kids[0])
  let ty = "[]" + first.ty
  let elt = llty(first.ty)
  let s = emit_new_slice(ty)
  emit_push_into(s.code, elt, first)
  var i = 1
  while i < len(e.kids) {
    let v = emit_list_elem(e.kids[i])
    if not (v.ty == first.ty) { perr(`list literal mixes element types {first.ty} and {v.ty}`) }
    emit_push_into(s.code, elt, v)
    i += 1
  }
  return s
}

# an element is its own file's code: a registry's entries come from the files their defs are in
# (L8), and what an entry may see (L3) is its own module's view, not the registry's
function emit_list_elem(k: Node) -> Val {
  let saved = g_err_file
  if k.file != null { g_err_file = k.file }
  let v = emit_expr(k)
  g_err_file = saved
  return v
}
# append the already-emitted value `v` (of LLVM element type `elt`) to the slice
# whose header is `h`, growing the storage when it is full
function emit_push_into(h: pointer, elt: pointer, v: Val) -> void {
  let lp = slice_field(h, 1);  let cp = slice_field(h, 2);  let dp = slice_field(h, 0)
  let l = emit_bind(`load i32, ptr {lp}`)
  let c = emit_bind(`load i32, ptr {cp}`)
  let full = emit_bind(`icmp sge i32 {l}, {c}`)
  let grow = lbl("grow");  let put = lbl("put")
  emit("  br i1 ");  emit(full);  emit(", label %");  emit(grow);  emit(", label %");  emit(put);  emit("\n")
  emit(grow);  emit(":\n")
  if g_push_cap > 0 {                              # 25.5a: growth past @max(n) is reported (R3D_ALLOC_FENCE=fail: exit 87)
    let over = emit_bind(`icmp sge i32 {l}, {itoa(g_push_cap)}`)
    let nm = emit_str_const(g_push_capname)
    let sayl = lbl("capover");  let okl = lbl("capok")
    emit(`  br i1 {over}, label %{sayl}, label %{okl}\n`)
    emit(`{sayl}:\n`)
    emit(`  call void @lp_cap_over(ptr {nm}, i32 {itoa(g_push_cap)}, i32 {l})\n`)
    emit(`  br label %{okl}\n`)
    emit(`{okl}:\n`)
    g_push_cap = 0
  }
  let dbl = emit_bind(`mul i32 {c}, 2`)
  let isz = emit_bind(`icmp eq i32 {c}, 0`)
  let nc = emit_bind(`select i1 {isz}, i32 8, i32 {dbl}`)
  let esz = emit_sizeof(elt)
  let ncw = emit_bind(`zext i32 {nc} to i64`)
  let bytes = emit_bind(`mul i64 {ncw}, {esz}`)
  let old = emit_bind(`load ptr, ptr {dp}`)
  let nd = emit_bind(`call ptr @lp_realloc(ptr {old}, i64 {bytes})`)
  emit("  store ptr ");  emit(nd);  emit(", ptr ");  emit(dp);  emit("\n")
  emit("  store i32 ");  emit(nc);  emit(", ptr ");  emit(cp);  emit("\n")
  emit("  br label %");  emit(put);  emit("\n")
  emit(put);  emit(":\n")
  let data = emit_bind(`load ptr, ptr {dp}`)
  let slot = nreg()
  emit("  ");  emit(slot);  emit(" = getelementptr inbounds ");  emit(elt);  emit(", ptr ");  emit(data);  emit(", i32 ");  emit(l);  emit("\n")
  emit("  store ");  emit(elt);  emit(" ");  emit(v.code);  emit(", ptr ");  emit(slot);  emit("\n")
  let l1 = emit_bind(`add i32 {l}, 1`)
  emit("  store i32 ");  emit(l1);  emit(", ptr ");  emit(lp);  emit("\n")
}