flan/test/programs/dev-ptr.flan
Joseph Ferano fe858811cb An address answers with a type, and a killed program is asked rather than hooked
The allocation registry had a recording side and half a reader. This is the
rest of the reader: point at any heap address, a breakdown by type, what is
still held, and the test that stops dev-ptr.flan's header from being read by
hand.

The recorded name, back to a type. The table records a string and has to —
the note is built where the concrete type exists and what crosses into the
runtime is bytes. What closes it is that the string is Types.to_string, which
is the source spelling, so the round trip is the language's own reader,
Parse.texpr and Check.resolve. No table of spellings is written down, so
nothing can fall behind Types.to_string, and a name that is not a type —
"pool slots" — is refused with the name quoted rather than defaulted.

The address root renders a (Ptr T) and not the pointee, which puts it through
render.ml's pointer arm: permission is asked in one place in the compiler, and
an address root and a slot root reach the same two answers by the same code.
Flan has no integer-to-pointer cast, so flan_dev_reg_addr is an extern beside
flan_agent_frame_slot, for the same reason.

One walk and two questions: a leak report is a breakdown with the dead left
out, so flan_dev_reg_by_type is one function and the agent formats it.

"At exit" is not a hook. A program killed by a signal runs no handler, which
is how a game under the editor ends, so (:op "leaks") is the authoritative
reader and can be asked at any moment including the one before the kill. The
atexit hook is for the program that returns from main, is registered from
inside flan_dev_reg_enable rather than by a file-scope destructor so that a
release build does not grow a third not-free place, and is off unless
FLAN_DEV_LEAKS is set because the acceptance table reads stderr.

The memcheck half of item 6 is deliberately not here.
2026-09-13 15:27:31 +07:00

66 lines
2.5 KiB
Plaintext

;;;; A stopped stack holding two pointers into Vec storage, one of which is
;;;; already dead. The allocation registry is what lets the inspector tell
;;;; them apart, and this is the program that shows it:
;;;;
;;;; ("live" "(Ptr Enemy)" "<ptr (Enemy {.hp 41 .x 2})>")
;;;; ("dead" "(Ptr Enemy)" "<ptr dead: was Enemy, freed at step N>")
;;;;
;;;; N is the registry's own event counter and is no part of the claim: it
;;;; moves if anything allocates or frees ahead of this program's two Vecs.
;;;; `test_dev.ml' matches around it and never on it.
;;;;
;;;; Both lines are what `(:op "locals" :frame 1)` answers with, and the
;;;; `a pointer the registry knows about' case in test_dev.ml is what drives
;;;; them. They were read off a running session by hand once; they are not
;;;; read by hand any more.
;;;;
;;;; Why a Vec rather than a struct on the stack: a stack address is not in
;;;; the registry by design — the shadow stack already answers for a local by
;;;; name — so a pointer to one renders <ptr>, which is neither half of what
;;;; this is demonstrating.
(import agent "vendor:agent")
(defstruct Boom [why i32])
(defstruct Enemy [hp i32 x i32])
;;; The address root — `(:op "at" :addr N)' — takes a number, and the things
;;; that hand out addresses as numbers all live outside the language: a
;;; debugger, valgrind, a C shim's printf. A Flan program has no cast for it
;;; on purpose — pointer arithmetic out of an integer is what the type system
;;; stops describing — so saying one out loud is a declare-c.
(declare-c ptr-num [p (Ptr Enemy)] i64 "flan_dev_reg_number")
;;; Where the two addresses are left for a reader to find. Globals rather than
;;; a printed line because a global is reachable by name from `C-x C-e' while
;;; the program is stopped, and a local is not: the test asks the session for
;;; them the way a person at the break loop would.
(defvar live-addr i64)
(defvar dead-addr i64)
(defn deeper [] i64
(restart-case
(do (error (Boom {.why 7})) 1)
(carry-on [] 5)))
(defn outer [] i64
(let [v (vec-new Enemy)
w (vec-new Enemy)]
(push v (Enemy {.hp 41 .x 2}))
(push w (Enemy {.hp 7 .x 9}))
(let [live (addr (at v 0))
dead (addr (at w 0))]
(free w)
(set live-addr (ptr-num live))
(set dead-addr (ptr-num dead))
(deeper))))
(defvar ticks i64)
(defn main [] i32
(agent/start "/tmp/flan-dev-ptr-fallback.sock")
(print (outer)) (println "")
(dotimes [i 4000]
(agent/wait 5)
(set ticks (+ ticks 1)))
0)