;;;; 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)