JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The listing buffers are malloc'd, and a followed pointer says why it stops

Browse Source 
Three follow-ups to the registry reader.

The agent's "reg types" handler held its four row buffers as statics. The lock
argument for that was right — request_lock is held across the whole of
handle_line from both entry points — but the BSS was not: 8KB in every build
this package is linked into, including a release build of a game that imports
the agent and never writes a row. That is flan_dev.c's own argument against a
fixed table at a thirty-second of the size. Malloc'd and freed per request,
like the watch handler beside it.

A followed pointer parses as an opaque node, so the inspector refused it with
"no structure for this type" — false and unhelpful at once. It has structure,
it is drawn, and the reason you cannot step in is that the step would start
from the pointee. Said that way instead.

And the three new commands have elisp tests: the address root's wire, that a
path is refused rather than dropped, the listing's rows and totals, the
overflow warning, and a build with no registry refusing rather than showing an
empty table that reads like a program holding nothing.
This commit is contained in:
Joseph Ferano 2026-09-13 15:33:25 +07:00
parent fe858811cb
commit a9c0c3e9bf
3 changed files with 150 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
emacs/flan-inspect.el
View File

@ -367,8 +367,16 @@ root, which is the older and the more limited of the two."
('trunc
"truncated: the walk stopped at its depth bound of 4. Inspect the field that holds it, which re-roots the walk")
('opaque
(format "%s: the walk had no structure for this type, so there are no fields to show"
(plist-get node :text)))
;; A *followed* pointer lands here rather than on the `ptr' arm above,
;; because that arm matches the bare word. Saying "no structure for this
;; type" of it would be false and unhelpful at once: it has structure, it
;; is right there, and the reason you cannot step in is that the step
;; would start from the pointee — the deref the registry blessed once and
;; is not being asked about again.
(if (string-prefix-p "<ptr " (or (plist-get node :text) ""))
"a pointer the registry let the renderer follow: the pointee is already drawn, one level deeper. Stepping in would step from it, which is a second deref nobody has asked about — root at it with `M-x flan-inspect-address' instead"
(format "%s: the walk had no structure for this type, so there are no fields to show"
(plist-get node :text))))
('atom (format "%s is an atom; it has no fields" (plist-get node :text)))
(_ "not something this inspector knows how to enter")))
@ -376,7 +384,7 @@ root, which is the older and the more limited of the two."
(defvar-local flan-inspect--root nil
"What this buffer's walk starts from.
Either `(:expr EXPR)\=' or `(:slot FRAME SLOT NAME)\='.")
One of `(:expr EXPR)\=', `(:slot FRAME SLOT NAME)\=' or `(:addr N TYPE)\='.")
(defvar-local flan-inspect--path nil
"The steps walked from `flan-inspect--root\=', outermost first.
Together with the root this is the whole of where the buffer is. It is a

116
emacs/test-flan-cider.el
View File

@ -208,6 +208,122 @@
(string-match-p "\\.name +\"all\"\n" text))))
;;; The address root, and the registry listings
(message "\nthe address root")
;; The rooting mode with no frame in it. What is asserted here is the *wire*:
;; the buffer sends `at' with the address, sends `:type' only when one was
;; named, and refuses a path rather than dropping it. What the daemon does
;; with that is test_dev.ml's business, over a real program.
(let* ((sent nil)
(flan-inspect-request-function
(lambda (form) (setq sent form) '(:status "ok" :value "<ptr (Enemy {.hp 41 .x 2})>"
:type "(Ptr Enemy)" :live t :recorded "Enemy")))
(flan-inspect-buffer " *test-inspect*"))
(when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
(let ((text (with-current-buffer
(save-window-excursion
(flan-inspect--show (list :addr 4096 nil) nil))
(buffer-string))))
(test-flan--check "an address root asks the daemon for `at'"
(equal (plist-get sent :op) "at"))
(test-flan--check "with the address"
(equal (plist-get sent :addr) 4096))
;; Absent and not empty: leaving it out is what makes the registry answer
;; for the type, which is the whole of what the address root buys.
(test-flan--check "and no :type when none was named"
(null (plist-get sent :type)))
(test-flan--check "the address is named in hex at the top"
(string-match-p "#x1000" text))))
(let* ((sent nil)
(flan-inspect-request-function
(lambda (form) (setq sent form) '(:status "ok" :value "<ptr 41>" :type "(Ptr i32)")))
(flan-inspect-buffer " *test-inspect*"))
(when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
(let ((text (with-current-buffer
(save-window-excursion
(flan-inspect--show (list :addr 4096 "i32") nil))
(buffer-string))))
(test-flan--check "a named type is sent as :type"
(equal (plist-get sent :type) "i32"))
(test-flan--check "and shown beside the address"
(string-match-p "#x1000 as i32" text))))
;; A path is refused rather than dropped. A path with a step silently gone
;; would render a different value and say nothing, which is the failure the
;; whole buffer is built to avoid.
(let ((flan-inspect-request-function
(lambda (_) '(:status "ok" :value "<ptr 41>"))))
(test-flan--check "an address root refuses a path"
(eq 'caught
(condition-case nil
(flan-inspect--value (list :addr 4096 nil) '((:field "x")))
(user-error 'caught)))))
;; And a followed pointer is refused for the true reason rather than for "no
;; structure": it has structure, it is drawn, and the step would be a second
;; deref nobody asked about.
(test-flan--check "a followed pointer says why it cannot be entered"
(string-match-p
"second deref"
(flan-inspect-refusal
(flan-inspect-parse "<ptr (Enemy {.hp 41 .x 2})>"))))
(message "\nthe registry listings")
(let* ((sent nil)
(flan-dev--request-stub
(lambda (form)
(setq sent form)
'(:status "ok"
:types (("Enemy" 2 64) ("i32" 1 16))
:blocks 3 :bytes 80 :overflow nil
:note "every block the registry recorded"))))
(cl-letf (((symbol-function 'flan-dev--request) flan-dev--request-stub)
((symbol-function 'display-buffer) #'ignore))
(let ((flan-allocations-buffer " *test-allocations*"))
(flan-allocations)
(test-flan--check "the breakdown asks for `allocations'"
(equal (plist-get sent :op) "allocations"))
(let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
(test-flan--check "and lists each type with its blocks and bytes"
(string-match-p "2 +64 +Enemy" text))
(test-flan--check "with a total under it"
(string-match-p "3 +80 +in 2 types" text)))
(flan-leaks)
(test-flan--check "the leak report asks for `leaks'"
(equal (plist-get sent :op) "leaks"))
(kill-buffer " *test-allocations*"))))
;; An overflowed table has blocks in the program that are in nobody's row, so
;; every number under it is a floor. Said before the numbers, because a reader
;; who missed it would quote them as counts.
(cl-letf (((symbol-function 'flan-dev--request)
(lambda (_) '(:status "ok" :types (("Enemy" 1 32)) :blocks 1 :bytes 32
:overflow t)))
((symbol-function 'display-buffer) #'ignore))
(let ((flan-allocations-buffer " *test-allocations*"))
(flan-allocations)
(let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
(test-flan--check "an overflowed table is said to be a floor"
(string-match-p "floors, not counts" text)))
(kill-buffer " *test-allocations*")))
;; And a release build, which records nothing and says so. The refusal comes
;; back as an ordinary error status and reaches the person, rather than an
;; empty listing that reads like a program holding nothing.
(cl-letf (((symbol-function 'flan-dev--request)
(lambda (_) '(:status "error"
:message "the allocation registry is off; this is not a dev build")))
((symbol-function 'display-buffer) #'ignore))
(test-flan--check "a build with no registry refuses rather than showing nothing"
(eq 'caught
(condition-case nil (flan-leaks) (user-error 'caught)))))
;;; The inspector buffer
(message "\nthe inspector buffer")

29
vendor/agent/flan_agent.c vendored
View File

@ -1061,15 +1061,31 @@ static void handle_line(char *line, sink *o) {
* a floor, and a reader that could not tell would quote them as counts. */
if (strcmp(line, "reg types") == 0 || strcmp(line, "reg leaks") == 0) {
enum { REG_ROWS = 256 };
/* Static rather than on the stack: 256 rows of four words is 8KB, and
* this thread's stack is whatever pthread gave it. Safe because
* [request_lock] is held — one request at a time, whoever asked, which is
* the same guarantee the ring's single producer rests on. */
static int64_t counts[REG_ROWS], bytes[REG_ROWS], typelens[REG_ROWS];
static const char *types[REG_ROWS];
/* Allocated here and freed before the reply is finished, not declared as
* static arrays. 256 rows of four words is 8KB, and static would put that
* 8KB in the BSS of every build this package is linked into — including a
* release build of a game that imports the agent, which never writes a
* row. That is flan_dev.c's own argument against a fixed table, at a
* thirty-second of the size, and it is the same rule: a release build
* carries a null pointer and the declarations.
*
* Allocating is legal here for [watch]'s reason and no other: this runs
* on the listener thread, or on the compiler thread in a merged build.
* The table the game thread writes is a fixed static in flan_dev.c
* precisely so that *it* allocates nothing. */
int64_t *counts = malloc(REG_ROWS * sizeof *counts);
int64_t *bytes = malloc(REG_ROWS * sizeof *bytes);
int64_t *typelens = malloc(REG_ROWS * sizeof *typelens);
const char **types = malloc(REG_ROWS * sizeof *types);
int64_t n, i;
int live_only = line[4] == 'l';
if (counts == NULL || bytes == NULL || typelens == NULL || types == NULL) {
free(counts); free(bytes); free(typelens); free(types);
reply(o, "err out of memory reading the allocation registry\n");
return;
}
if (!flan_dev_reg_enabled()) {
free(counts); free(bytes); free(typelens); free(types);
reply(o, "err the allocation registry is off; this is not a dev build\n");
return;
}
@ -1090,6 +1106,7 @@ static void handle_line(char *line, sink *o) {
if (typelens[i] > 0) emit(o, types[i], (size_t)typelens[i]);
reply(o, "\n");
}
free(counts); free(bytes); free(typelens); free(types);
return;
}
/* Before the dlopen, not after it: a module there is no room to queue is