erlang: exit-signal propagation + trap_exit (+11 tests)

lib/erlang/runtime.sx

@@ -324,6 +324,29 @@
   er-bif-is-reference
   (fn (vs) (er-bool (er-ref? (er-bif-arg1 vs "is_reference")))))
 
+(define
+  er-bif-process-flag
+  (fn
+    (vs)
+    (if
+      (not (= (len vs) 2))
+      (error "Erlang: process_flag/2: arity")
+      (let
+        ((flag (nth vs 0))
+          (val (nth vs 1))
+          (me (er-sched-current-pid)))
+        (cond
+          (and (er-atom? flag) (= (get flag :name) "trap_exit"))
+          (let
+            ((old (er-proc-field me :trap-exit)))
+            (er-proc-set! me :trap-exit (er-truthy? val))
+            (er-bool old))
+          :else (error
+            (str
+              "Erlang: process_flag: unsupported flag '"
+              (er-format-value flag)
+              "'")))))))
+
 (define
   er-bif-make-ref
   (fn
@@ -551,6 +574,14 @@
 
 (define
   er-sched-step!
+  (fn
+    (pid)
+    (cond
+      (= (er-proc-field pid :state) "dead") nil
+      :else (er-sched-step-alive! pid))))
+
+(define
+  er-sched-step-alive!
   (fn
     (pid)
     (er-sched-set-current! pid)
@@ -578,10 +609,103 @@
             (er-proc-set! pid :state "dead")
             (er-proc-set! pid :exit-reason (get r :reason))
             (er-proc-set! pid :exit-result nil)
-            (er-proc-set! pid :continuation nil))
+            (er-proc-set! pid :continuation nil)
+            (er-propagate-exit! pid (get r :reason)))
           :else (do
             (er-proc-set! pid :state "dead")
             (er-proc-set! pid :exit-reason (er-mk-atom "normal"))
             (er-proc-set! pid :exit-result r)
-            (er-proc-set! pid :continuation nil)))))
+            (er-proc-set! pid :continuation nil)
+            (er-propagate-exit! pid (er-mk-atom "normal"))))))
     (er-sched-set-current! nil)))
+
+;; ── exit-signal propagation ─────────────────────────────────────
+;; Called when `pid` finishes (normally or via exit). Walks the
+;; process's `:monitored-by` and `:links` lists to deliver `{'DOWN'}`
+;; messages and exit signals respectively. Linked processes without
+;; `trap_exit` cascade-die with the same reason; those with
+;; `trap_exit` true receive an `{'EXIT', From, Reason}` message.
+(define
+  er-propagate-exit!
+  (fn
+    (pid reason)
+    (er-fire-monitors! pid reason)
+    (er-fire-links! pid reason)))
+
+(define
+  er-fire-monitors!
+  (fn
+    (pid reason)
+    (let
+      ((mons (er-proc-field pid :monitored-by)))
+      (for-each
+        (fn
+          (i)
+          (let
+            ((m (nth mons i)))
+            (let
+              ((from (get m :from)) (ref (get m :ref)))
+              (when
+                (and (er-proc-exists? from)
+                  (not (= (er-proc-field from :state) "dead")))
+                (let
+                  ((msg
+                    (er-mk-tuple
+                      (list
+                        (er-mk-atom "DOWN")
+                        ref
+                        (er-mk-atom "process")
+                        pid
+                        reason))))
+                  (er-proc-mailbox-push! from msg)
+                  (when
+                    (= (er-proc-field from :state) "waiting")
+                    (er-proc-set! from :state "runnable")
+                    (er-sched-enqueue! from)))))))
+        (range 0 (len mons))))))
+
+(define
+  er-fire-links!
+  (fn
+    (pid reason)
+    (let
+      ((links (er-proc-field pid :links))
+        (is-normal (er-is-atom-named? reason "normal")))
+      (for-each
+        (fn
+          (i)
+          (let
+            ((target (nth links i)))
+            (when
+              (and (er-proc-exists? target)
+                (not (= (er-proc-field target :state) "dead")))
+              (let
+                ((trap (er-proc-field target :trap-exit)))
+                (cond
+                  trap (er-deliver-exit-msg! target pid reason)
+                  is-normal nil
+                  :else (er-cascade-exit! target reason))))))
+        (range 0 (len links))))))
+
+(define
+  er-deliver-exit-msg!
+  (fn
+    (target from reason)
+    (let
+      ((msg
+        (er-mk-tuple (list (er-mk-atom "EXIT") from reason))))
+      (er-proc-mailbox-push! target msg)
+      (when
+        (= (er-proc-field target :state) "waiting")
+        (er-proc-set! target :state "runnable")
+        (er-sched-enqueue! target)))))
+
+(define
+  er-cascade-exit!
+  (fn
+    (target reason)
+    (er-proc-set! target :state "dead")
+    (er-proc-set! target :exit-reason reason)
+    (er-proc-set! target :exit-result nil)
+    (er-proc-set! target :continuation nil)
+    (er-propagate-exit! target reason)))