erlang: code:purge/1 + code:soft_purge/1 (+10 eval tests)

This commit is contained in:
2026-05-14 19:02:24 +00:00
parent 89a6b30501
commit cd45ebcc7a
5 changed files with 129 additions and 6 deletions

View File

@@ -1967,11 +1967,80 @@
:else
(er-mk-tuple (list (er-mk-atom "module") mod-arg))))))))))
(define er-procs-on-env
(fn (target-env)
(let ((all-keys (keys (er-sched-processes)))
(matches (list)))
(for-each
(fn (i)
(let ((proc (get (er-sched-processes) (nth all-keys i))))
(let ((init-fun (get proc :initial-fun)))
(when (and (not (= init-fun nil))
(er-fun? init-fun)
(= (get init-fun :env) target-env)
(not (= (get proc :state) "dead")))
(append! matches (get proc :pid))))))
(range 0 (len all-keys)))
matches)))
(define er-bif-code-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "false")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "false")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(for-each
(fn (i) (er-cascade-exit! (nth procs i) (er-mk-atom "killed")))
(range 0 (len procs)))
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))
(define er-bif-code-soft-purge
(fn (vs)
(let ((mod-arg (nth vs 0)))
(cond
(not (er-atom? mod-arg))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((registry (er-modules-get)) (mod-name (get mod-arg :name)))
(cond
(not (dict-has? registry mod-name)) (er-mk-atom "true")
:else
(let ((slot (get registry mod-name)))
(cond
(= (er-module-old-env slot) nil) (er-mk-atom "true")
:else
(let ((procs (er-procs-on-env (er-module-old-env slot))))
(cond
(> (len procs) 0) (er-mk-atom "false")
:else
(do
(dict-set! registry mod-name
(er-mk-module-slot (er-module-current-env slot) nil
(er-module-version slot)))
(er-mk-atom "true"))))))))))))
(define er-apply-code-bif
(fn (name vs)
(cond
(and (= name "load_binary") (= (len vs) 3))
(er-bif-code-load-binary vs)
(and (= name "purge") (= (len vs) 1))
(er-bif-code-purge vs)
(and (= name "soft_purge") (= (len vs) 1))
(er-bif-code-soft-purge vs)
:else (error
(str "Erlang: undefined function 'code:" name "/" (len vs) "'")))))