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.
66 lines
2.5 KiB
Plaintext
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)
|