feat: add TP v1+v2 transaction contract

CHANGELOG.md

@@ -9,6 +9,8 @@ All notable changes to the tp library are documented here.
 - A standalone retained surface runtime with pure defensive plans, prepare-scoped stable objects, keyed/positional reconciliation, content and properties capabilities, marker-backed range anchors, object/mount indexes, scoped updates, opaque client state, generic reports, and lifecycle cleanup.
 - Exact signal-to-binding and binding-to-binding dependency tracking with conditional rewiring, equality cutoffs, batched transactions, nested-write stabilization, owner disposal, buffer-scoped sources, variable adapters, cycle paths, and public structural counters.
 - Atomic single- and multi-surface publication with candidate source values, prepare-all/publish-all ordering, explicit property journals, rollback-capable transaction participants, observer isolation, and authoritative kill-buffer cleanup.
+- Additive transaction protocol v2 artifacts: transaction-scoped publication batches, structured v1 participant bridges, bounded opaque final-accept markers using the closed `tp-vector-slots/v1` primitive, immutable tagged outcomes, and property/revision shadow proofs over the unchanged v1 live writer.
+- `tp-runtime-manifest`, advertising `tp-transaction-protocol-v1+v2` without removing the v1 participant route.
 - Native property policies and contribution composition with explicit nil/absence, normalization, validation, equality, merge, projection, named direct styles, and explicit `tp-computed` value sources.
 - `tp-propertize`, `tp-apply`, and `tp-watch` as the one-shot string, one-shot buffer-range, and reactive existing-text conveniences over the same direct property/surface core.
 - Retained logical objects with `tp-object-retain` and `tp-object-attach-fragment`, allowing one object to own multiple disjoint physical fragments without placing handles or positions in plans.

Makefile

@@ -4,6 +4,8 @@
 #   make test                 # run all ERT test suites
 #   make test-shuffled        # run the suite in a random order (SHUFFLE_SEED=n reproduces)
 #   make test-m0a             # run current TP completion characterization
+#   make test-m1a             # run additive transaction contract + fault gates
+#   make test-v1              # run every legacy suite with v2 artifacts disabled
 #   make doctest              # execute README examples against the code
 #   make benchmark            # run reproducible correctness-first benchmarks
 #   make compile              # byte-compile the library modules
@@ -22,14 +24,15 @@ WERROR ?= nil
 TEST_DIR = tests
 LOADPATH = -L . -L $(TEST_DIR) -L examples $(LOAD_EXTRA)
 
-SRC = tp-core.el tp-style.el tp-reactive.el tp-surface.el tp-layer.el tp-ops.el tp-search.el \
+SRC = tp-core.el tp-style.el tp-transaction.el tp-reactive.el tp-surface.el tp-layer.el tp-ops.el tp-search.el \
       tp-query.el tp-palette.el tp-builtins.el tp.el
 TESTS = $(wildcard $(TEST_DIR)/*-tests.el)
+V1_TESTS = $(filter-out $(TEST_DIR)/tp-transaction-tests.el,$(TESTS))
 TEST_SUPPORT = $(TEST_DIR)/tp-doctest.el $(TEST_DIR)/tp-run-shuffled.el
 EXAMPLES = $(wildcard examples/*.el)
 DEV = $(TEST_SUPPORT) $(EXAMPLES) tp-benchmark.el
 
-.PHONY: test test-m0a test-shuffled doctest benchmark compile compile-all checkdoc package-lint diff-check clean
+.PHONY: test test-m0a test-m1a test-v1 test-shuffled doctest benchmark compile compile-all checkdoc package-lint diff-check clean
 
 test:
 	$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
@@ -42,6 +45,19 @@ test-m0a:
 	  -l $(TEST_DIR)/tp-m0a-characterization-tests.el \
 	  --eval '(ert-run-tests-batch-and-exit "tp-m0a-characterization-test-\\|tp-binding-test-signal-commit-journal-rolls-back-every-write\\|tp-binding-test-rollback-preserves-primary-and-runs-all-phases\\|tp-surface-test-global-signal-update-is-multi-surface-atomic\\|tp-surface-test-full-and-scoped-precommit-stages-roll-back\\|tp-surface-test-full-and-scoped-final-accept-roll-back")'
 
+test-m1a:
+	$(EMACS) -Q --batch $(LOADPATH) -l tp.el \
+	  -l $(TEST_DIR)/tp-binding-tests.el \
+	  -l $(TEST_DIR)/tp-surface-tests.el \
+	  -l $(TEST_DIR)/tp-m0a-characterization-tests.el \
+	  -l $(TEST_DIR)/tp-transaction-tests.el \
+	  --eval '(ert-run-tests-batch-and-exit "tp-transaction-test-\\|tp-m0a-characterization-test-\\|tp-binding-test-signal-commit-journal-rolls-back-every-write\\|tp-binding-test-rollback-preserves-primary-and-runs-all-phases\\|tp-surface-test-global-signal-update-is-multi-surface-atomic\\|tp-surface-test-full-and-scoped-precommit-stages-roll-back\\|tp-surface-test-full-and-scoped-final-accept-roll-back")'
+
+test-v1:
+	$(EMACS) -Q --batch $(LOADPATH) -l tp.el \
+	  --eval '(setq tp--transaction-artifact-mode (quote v1))' \
+	  $(patsubst %,-l %,$(V1_TESTS)) -f ert-run-tests-batch-and-exit
+
 test-shuffled:
 	$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
 	  -l tp-run-shuffled.el

README.md

@@ -146,6 +146,15 @@ TP records the host baseline and each TP contribution per property interval. Ove
 
 Observers run only after a successful commit. Their failures are recorded and do not roll back an already committed transaction. A buffer killed during publication remains killed; rollback never recreates it.
 
+TP also builds an internal transaction-scoped batch view over the same v1
+participants, journals, surface snapshots, and single final accept.  Shadow
+mode compares canonical target artifacts and tagged outcomes with the one v1
+writer; it never opens a second change group or writes a buffer twice.  Generic
+opaque authority markers are bounded and whitelist-validated before final
+accept, then reverse-restored before ordinary rollback on partial apply or
+accept failure.  `tp-with-transaction` still returns its body value, and
+internal outcomes remain observational side-channel evidence.
+
 ETAF integration uses the same boundary through one opaque transaction
 participant. ETAF prepares its immutable generation and Ebox candidate before
 TP accepts the transaction; participant publish, TP final accept, and
@@ -174,7 +183,7 @@ cycles instead of spinning.
 | Core inspection and debug | `tp-debug-*`, `tp-intervals`, `tp-intervals-map`, `tp-plist`, `tp-text-snapshot`, `tp-empty-p` |
 | Property policy and declarations | `tp-define-property-policy`, `tp-register-text-property`, `tp-text-declarations`, `tp-computed`, `tp-resolve-value`, `tp-merge-declarations`, `tp-define-style`, `tp-style-declarations` |
 | Static recipes | `define-tp`/`tp-define-layer`, `define-tps`/`define-tp-group`/`tp-define-group`, layer/group queries, undefine/reset/describe |
-| Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate`, read-only `tp-transaction-active-p`, counters/reset |
+| Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate`, read-only `tp-transaction-active-p`, `tp-runtime-manifest`, counters/reset |
 | Objects and plans | plan/result constructors, `tp-object-ensure`, retain/reuse, fragment/content-range attachment, resolve, mounted/mounts |
 | Host ranges | `tp-range-anchor-create`, `tp-range-anchor-live-p`, `tp-object-attach-range`, `tp-range-rebase` |
 | Surfaces | mount/update/scoped update, materialize, live/revision/client-state, at-point, report/report-summary/inspect, unmount |

README_CN.md

@@ -145,6 +145,14 @@ TP 为每个 property interval 保存 host baseline 和各个 TP contribution。
 
 observer 只在成功提交之后运行，observer failure 只记录，不回滚已完成的 transaction。publication 过程中被 kill 的 buffer 保持死亡，rollback 不会把它重新创建。
 
+TP 还会在同一份 v1 participant、journal、surface snapshot 和 single final
+accept 上建立内部 transaction-scoped batch view。shadow mode 只比较 canonical
+target artifact 与 tagged outcome，仍由唯一 v1 writer 写入；不会建立第二个
+change group，也不会双写 Buffer。generic opaque authority marker 在 final
+accept 前完成固定上界与 whitelist 校验；partial apply 或 accept failure 时先
+逆序恢复 marker，再执行普通 rollback。`tp-with-transaction` 仍返回 body
+result，内部 outcome 仅作为只读 side-channel evidence。
+
 ETAF 集成复用同一事务边界，只注册一个 opaque transaction participant。ETAF
 先准备 immutable generation 和 Ebox candidate，再由 TP 按固定顺序完成
 participant publish、TP final accept 和 post-accept cleanup。participant failure
@@ -171,7 +179,7 @@ effect 的 input/version tuple，重复或超过图规模上限时停止循环
 | Core inspection 与 debug | `tp-debug-*`、`tp-intervals`、`tp-intervals-map`、`tp-plist`、`tp-text-snapshot`、`tp-empty-p` |
 | Property policy 与 declaration | `tp-define-property-policy`、`tp-register-text-property`、`tp-text-declarations`、`tp-computed`、`tp-resolve-value`、`tp-merge-declarations`、`tp-define-style`、`tp-style-declarations` |
 | 静态 recipe | `define-tp`/`tp-define-layer`、`define-tps`/`define-tp-group`/`tp-define-group`、layer/group 查询、undefine/reset/describe |
-| Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate`、只读 `tp-transaction-active-p`、counter/reset |
+| Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate`、只读 `tp-transaction-active-p`、`tp-runtime-manifest`、counter/reset |
 | Object 与 plan | plan/result constructor、`tp-object-ensure`、retain/reuse、fragment/content-range attach、resolve、mounted/mounts |
 | Host range | `tp-range-anchor-create`、`tp-range-anchor-live-p`、`tp-object-attach-range`、`tp-range-rebase` |
 | Surface | mount/update/scoped update、materialize、live/revision/client-state、at-point、report/report-summary/inspect、unmount |

docs/API-REFERENCE.md

@@ -233,6 +233,8 @@ tp-binding-dispose 释放单个 binding。
 
 (tp-transaction-active-p)
 
+(tp-runtime-manifest)
+
 (tp-variable-signal 'my-variable)
 (tp-variable-signal 'my-buffer-variable some-buffer)
 (tp-reactive-counters)
@@ -251,6 +253,13 @@ tp-transaction-active-p 是只读边界查询：只在当前 dynamic extent 已
 对象、participant 或内部状态，调用方只能用它在 mutation 前拒绝不支持的
 嵌套事务边界。
 
+tp-runtime-manifest 返回防御性 capability snapshot；本版本的
+`:transaction-protocol` 为 `tp-transaction-protocol-v1+v2`。该声明是 additive：
+旧 `tp-transaction-participate` façade 与 live writer 都仍保留。
+`:batch-artifacts` 与 `:shadow-proof` 为 non-nil，`:batch-execution` 为
+`v1-bridge`，而 `:batch-execute` 明确为 nil；structured-core execute owner
+保留给后续受控 cutover，不在 M1a 伪造第二个 coordinator。
+
 ETAF registers one opaque participant for its immutable generation and Ebox
 client state. Its publish is paired with rollback across TP final accept; the
 ETAF runtime separately records effect input/version tuples and reports a
@@ -601,7 +610,8 @@ TP 1.0 已删除并且不应在新代码中使用：
 | tp-core.el | tp-debug-*、tp-with-current-buffer、tp-intervals、tp-intervals-map、tp-empty-p、tp-plist、tp-text-snapshot |
 | tp-style.el | tp-define-property-policy、tp-property-policy、tp-text-property-id、tp-register-text-property、tp-text-declarations、tp-computed、tp-resolve-value、tp-merge-declarations、tp-define-style、tp-style-declarations、tp-undefine-style |
 | tp-layer.el | define-tp/tp-define-layer、define-tps/define-tp-group/tp-define-group、layer/group query、tp-layer-reset、tp-undefine-*、tp-describe-layer |
-| tp-reactive.el | signal、binding、transaction、variable adapter、counter 和 reset API |
+| tp-transaction.el | additive batch/entry、final-marker 与 tagged-outcome 内部合同 |
+| tp-reactive.el | signal、binding、transaction coordinator、variable adapter、counter 和 reset API |
 | tp-surface.el | plan/result、object、range anchor、surface lifecycle、scoped update、report、tp-watch |
 | tp-ops.el | tp-propertize、tp-apply、tp-set、tp-reset、tp-add、tp-remove、tp-clear、tp-get、tp-at、tp-member |
 | tp-search.el | tp-match-*、tp-regexp-*、tp-search、tp-search-map、tp-forward*、tp-backward*、tp-any-value |

docs/API-SEMANTICS.md

@@ -197,13 +197,26 @@ TP 为每个 interval 保存：
 4. 校验 object、plan、capability、range、conflict 与 lifecycle；
 5. 为所有 surfaces 准备 text/property operations 与 inverse journals；
 6. 按稳定 surface id publish；
-7. 原子切换 signals、bindings、plans、mount/index、client state 和 revisions；
+7. 按声明顺序 stage participant，再执行 declared precommit；
-8. 全部成功后运行 observers。
+8. commit signal journal；
+9. 在 single final accept 内按顺序 apply bounded opaque markers，再 accept
+   change group；marker 只能使用 closed `tp-vector-slots/v1` fixed-write
+   primitive，不能注册 callback；partial apply 或 accept failure 先逆序
+   restore markers；
+10. final accept 成功后固定写入 tagged success，再运行 contained
+    committed/observer work。
 
 嵌套 transaction 加入最外层。一个 global signal 可以原子触达多个 buffers；任一 surface 失败时，已发布 surfaces 和 source/binding state 全部回滚。
 
 `tp-transaction-participate` 允许 client side state 在 surfaces 发布后、source commit 前加入同一 rollback boundary。participant key 在一个 outer transaction 中必须唯一。它不是 observer；失败会回滚 transaction。Observer failure 只记录，不回滚已提交结果。
 
+M1a 的 publication batch、structured participant、final marker 与 tagged
+outcome 都是现有 v1 dynamic transaction state 的内部结构化 view，不复制第二份
+participant/journal/change-group，也不切换 live writer。shadow proof 只比较 v1/v2
+artifact 与 outcome，不双写 Buffer。`tp-with-transaction` 的返回值仍是 body
+result；success/failure outcome 只走内部 side channel。zero-surface 与
+output-equal operation 不创建 publication batch。
+
 ETAF uses this API with one opaque participant for its immutable generation and
 Ebox client state. The participant is published only after candidate
 preparation, and its paired rollback is still required when TP final accept

docs/ARCHITECTURE.md

@@ -26,6 +26,7 @@ TP 不依赖 Ebox 或 ECSS，不包含 selector、stylesheet、CSS cascade、Box
 ```text
 tp-core
   ├─ tp-style
+  ├─ tp-transaction
   │    └─ tp-reactive
   │         └─ tp-surface
   ├─ tp-layer
@@ -44,6 +45,7 @@ tp.el loads the public package surface
 | --- | --- | --- |
 | `tp-core.el` | canonical ranges/requests/results、interval traversal、plist/face merge、native property facts | runtime identity、reactivity、publication |
 | `tp-style.el` | native property policies、direct declarations、explicit computed source、projection | selector、stylesheet、specificity、CSS winner |
+| `tp-transaction.el` | additive batch/entry validators、one-shot states、opaque final-marker descriptors、tagged outcomes | live buffer writer、consumer semantics、parallel journals |
 | `tp-reactive.el` | signals、bindings、dynamic dependency graph、scheduler、candidate source state、transaction participants | buffer scans、mount positions、layout impact |
 | `tp-surface.el` | prepare context、objects、plans、anchors、mount/index、contribution ledger、diff、publication、rollback、reports | stylesheet/cascade、consumer layout decisions |
 | `tp-layer.el` | `define-tp`/`define-tps` declaration recipes and registry | live layer stack、inline runtime metadata、watcher engine |
@@ -180,6 +182,12 @@ An equal candidate produces no prepared publication. It preserves revision, repo
 
 The outer transaction owns candidate source values, dirty bindings, prepared surfaces, participants, inverse journals, view state, and final observer scheduling.
 
+The additive v2 contract is a structured view over those exact owners.  It does
+not copy participant, scheduler, snapshot, journal, or change-group state.  The
+public v1 participant façade and the v1 surface writer remain authoritative;
+shadow mode constructs canonical entries and compares property-for-property and
+revision-for-revision after commit or rollback.
+
 ```text
 freeze candidate writes
   → recompute exact dependency closure
@@ -188,7 +196,11 @@ freeze candidate writes
   → capture inverse journals
   → publish surfaces in stable id order
   → publish transaction participants
-  → commit signals/bindings/surface state/revisions
+  → run precommit validators
+  → commit signals
+  → apply bounded opaque final markers
+  → invoke the single final accept
+  → finalize tagged success evidence
   → run observers
 ```
 
@@ -198,6 +210,15 @@ Rollback restores text, properties, marker/index state, plans, producer, client
 
 `tp-transaction-participate` lets a consumer promote rollback-capable opaque state inside this boundary. Observers are different: they run only after the transaction commits, and observer failure is recorded rather than rolled back.
 
+The v1 participant record is also its structured v2 bridge: one stable key,
+registration order, stage, rollback, optional declared precommit, contained
+after-commit work, owner journal, and one-shot state.  Final markers are not
+participants.  TP treats their values as opaque and accepts only predeclared,
+fixed-bound operations.  M1a's closed `tp-vector-slots/v1` primitive accepts
+only prebuilt vector-slot expectations and writes; marker registration cannot
+inject callbacks.  Partial apply or final-accept failure restores markers in
+reverse order before the existing participant/surface/signal rollback.
+
 If publication kills a target buffer, kill teardown is authoritative. Other surfaces and source state roll back; TP never recreates the killed buffer.
 
 ### ETAF participant contract

tp-core.el

@@ -323,6 +323,7 @@ so dotted tails, shared suffixes, and cycles retain their source topology."
 
 (defun tp--copy-proper-cons-list (value cache)
   "Return a fast memoized copy of uncached proper-list VALUE.
+CACHE preserves sharing and cycles across the copied value graph.
 The whole spine is registered before mutable cars are copied, preserving
 back-references from cars while `copy-sequence' supplies the spine cheaply."
   (let ((source value)
@@ -352,6 +353,7 @@ back-references from cars while `copy-sequence' supplies the spine cheaply."
 (defun tp--copy-string-with-properties
     (value &optional cache reuse-property-p)
   "Return a copy of string VALUE with recursively copied property values.
+CACHE preserves sharing across mutable property values.
 REUSE-PROPERTY-P, when non-nil, is called with PROPERTY and VALUE.  A non-nil
 result transfers that exact candidate-owned VALUE into the returned string;
 the caller must ensure that VALUE is not mutated by another owner.  Values not
@@ -403,6 +405,7 @@ values are recursively isolated."
 
 (defun tp--copy-property-value (value &optional cache)
   "Return a defensive copy of mutable containers in property VALUE.
+Optional CACHE preserves sharing and cycles across recursive copies.
 Cons cells, strings, and vectors are copied recursively.  Functions, records,
 and other opaque objects keep their identity; functions are never executed."
   (if (not (tp--copy-mutable-property-value-p value))

tp-reactive.el

@@ -18,6 +18,7 @@
 
 (require 'cl-lib)
 (require 'tp-core)
+(require 'tp-transaction)
 
 (define-error 'tp-reactive-error "TP reactive runtime error")
 (define-error 'tp-invalid-signal-scope "Invalid TP signal scope"
@@ -43,8 +44,8 @@
 
 (cl-defstruct (tp--transaction-participant
                (:constructor tp--make-transaction-participant))
-  "One rollback-capable side-state participant in a TP transaction."
+  "One structured participant shared by the v1 and v2 transaction views."
-  key publish rollback)
+  key publish rollback protocol order stage precommit after-commit journal state)
 
 (cl-defstruct (tp--signal-commit-entry
                (:constructor tp--make-signal-commit-entry))
@@ -85,10 +86,27 @@
 (defvar tp--transaction-after-commit-callbacks nil)
 (defvar tp--transaction-participants nil)
 (defvar tp--transaction-participant-keys nil)
+(defvar tp--transaction-participant-order 0)
 (defvar tp--transaction-published-participants nil)
 (defvar tp--transaction-signal-commit-journal nil)
+(defvar tp--transaction-id nil)
+(defvar tp--transaction-phase nil)
+(defvar tp--transaction-phase-start nil)
+(defvar tp--transaction-phase-timings nil)
+(defvar tp--transaction-publication-batch nil)
+(defvar tp--transaction-final-marker-registry nil)
+(defvar tp--transaction-final-marker-owner-keys nil)
+(defvar tp--transaction-final-marker-count 0)
+(defvar tp--transaction-final-marker-slot-writes 0)
+(defvar tp--transaction-final-markers-frozen-p nil)
+(defvar tp--transaction-applied-final-marker-count 0)
+(defvar tp--transaction-marker-restore-failures nil)
+(defvar tp--transaction-outcome nil)
+(defvar tp--transaction-outcome-cell nil)
 (defvar tp--transaction-contained-failures nil)
 (defvar tp--last-transaction-diagnostics nil)
+(defvar tp--last-transaction-outcome nil)
+(defvar tp--last-shadow-proof nil)
 (defvar tp--current-binding nil)
 (defvar tp--binding-compute-stack nil)
 (defvar tp--collected-dependency-set nil)
@@ -108,6 +126,12 @@
 (defvar tp--transaction-rollback-final-functions nil)
 (defvar tp--transaction-committed-functions nil)
 
+(defvar tp--transaction-artifact-mode 'shadow
+  "Internal artifact route; the live writer remains the v1 coordinator.")
+
+(defvar tp--transaction-participant-precommit-allowed-functions nil
+  "Declared internal structured-participant precommit validators.")
+
 (defconst tp--transaction-condition-trailer-tag
   (make-symbol "tp--transaction-condition-trailer")
   "Unforgeable tag separating primary condition data from TP metadata.")
@@ -497,7 +521,8 @@ or `retain'."
 
 (defun tp--bind-precomputed-in-transaction
     (owner key compute value dependencies equality lifecycle)
-  "Install one new initialized binding with explicit DEPENDENCIES."
+  "Install OWNER's KEY using COMPUTE, VALUE, and explicit DEPENDENCIES.
+EQUALITY controls change detection and LIFECYCLE controls candidate omission."
   (let ((table (tp--owner-binding-table owner t)))
     (when (gethash key table)
       (signal 'tp-reactive-error (list :precomputed-binding-exists key)))
@@ -526,6 +551,8 @@ or `retain'."
     (owner key compute value dependencies
            &key (equality #'equal) (lifecycle 'delete))
   "Install a new binding with precomputed VALUE and explicit DEPENDENCIES.
+OWNER and KEY identify the binding; EQUALITY and LIFECYCLE retain their normal
+`tp-bind' meanings.
 COMPUTE remains the authoritative recomputation function after any dependency
 changes.  This entry avoids evaluating COMPUTE merely to rediscover a value
 and graph edges already produced by a compiler or pure projection pass."
@@ -624,6 +651,56 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
     (signal 'tp-reactive-error (list :outside-transaction function)))
   (push function tp--transaction-after-commit-callbacks))
 
+(defun tp--transaction-participant-precommit-function-p (function)
+  "Return non-nil when FUNCTION is a declared internal participant validator."
+  (or (null function)
+      (and (symbolp function)
+           (memq function
+                 tp--transaction-participant-precommit-allowed-functions)
+           (fboundp function))))
+
+(defun tp--transaction-register-participant (participant)
+  "Register structured PARTICIPANT in the authoritative v1 participant list."
+  (unless tp--transaction-active
+    (signal 'tp-reactive-error
+            (list :participant-outside-transaction
+                  (tp--transaction-participant-key participant))))
+  (let ((key (tp--transaction-participant-key participant)))
+    (unless key
+      (signal 'tp-reactive-error (list :participant-key key)))
+  (when (member key tp--transaction-participant-keys)
+    (signal 'tp-reactive-error (list :duplicate-participant-key key)))
+    (push (tp--copy-property-value key) tp--transaction-participant-keys)
+    (push participant tp--transaction-participants)
+    participant))
+
+(defun tp--transaction-make-participant
+    (key publish rollback protocol precommit after-commit journal)
+  "Build a participant from KEY, PUBLISH, ROLLBACK, and PROTOCOL.
+PRECOMMIT and AFTER-COMMIT are optional internal callbacks; JOURNAL is opaque
+owner-local rollback state."
+  (unless (functionp publish)
+    (signal 'wrong-type-argument (list 'functionp publish)))
+  (unless (functionp rollback)
+    (signal 'wrong-type-argument (list 'functionp rollback)))
+  (unless (tp--transaction-participant-precommit-function-p precommit)
+    (signal 'tp-reactive-error
+            (list :invalid-participant-precommit precommit)))
+  (unless (or (null after-commit) (functionp after-commit))
+    (signal 'wrong-type-argument (list 'functionp after-commit)))
+  (tp--make-transaction-participant
+   :key (tp--copy-property-value key)
+   :publish publish
+   :rollback rollback
+   :protocol protocol
+   :order (prog1 tp--transaction-participant-order
+            (cl-incf tp--transaction-participant-order))
+   :stage publish
+   :precommit precommit
+   :after-commit after-commit
+   :journal journal
+   :state 'prepared))
+
 ;;;###autoload
 (defun tp-transaction-participate (key publish rollback)
   "Register rollback-capable PUBLISH work under transaction-local KEY.
@@ -631,43 +708,79 @@ PUBLISH runs after every affected surface has published its candidate buffer
 and side state, but before the transaction commits its source values.  If this
 or any later publication step fails, ROLLBACK runs in reverse publication
 order.  Both functions take no arguments.  KEY must be unique in the outer
-transaction."
+transaction.  The public v1 route is retained and receives an internal v2
+structured view over the same participant object."
   (unless tp--transaction-active
     (signal 'tp-reactive-error (list :participant-outside-transaction key)))
   (unless key
     (signal 'tp-reactive-error (list :participant-key key)))
-  (unless (functionp publish)
+  (let ((participant
-    (signal 'wrong-type-argument (list 'functionp publish)))
+         (tp--transaction-make-participant
-  (unless (functionp rollback)
+          key publish rollback 'v1-bridge nil nil nil)))
-    (signal 'wrong-type-argument (list 'functionp rollback)))
+    (tp--transaction-register-participant participant)
-  (when (member key tp--transaction-participant-keys)
+    key))
-    (signal 'tp-reactive-error (list :duplicate-participant-key key)))
+
-  (push (tp--copy-property-value key) tp--transaction-participant-keys)
+(cl-defun tp--transaction-participate-v2
-  (push (tp--make-transaction-participant
+    (&key key stage rollback precommit after-commit journal)
-         :key (tp--copy-property-value key)
+  "Register internal KEY with STAGE and ROLLBACK through the v1 coordinator.
-         :publish publish :rollback rollback)
+PRECOMMIT and AFTER-COMMIT are optional declared callbacks.  JOURNAL is the
-        tp--transaction-participants)
+participant's opaque owner-local state."
-  key)
+  (unless tp--transaction-active
+    (signal 'tp-reactive-error (list :participant-outside-transaction key)))
+  (unless key
+    (signal 'tp-reactive-error (list :participant-key key)))
+  (tp--transaction-register-participant
+   (tp--transaction-make-participant
+    key stage rollback 'v2 precommit after-commit journal)))
+
+(defun tp--transaction-participants-in-registration-order ()
+  "Return the authoritative participants in deterministic declaration order."
+  (reverse tp--transaction-participants))
 
 (defun tp--publish-transaction-participants ()
   "Publish registered transaction participants in declaration order."
-  (dolist (participant (nreverse tp--transaction-participants))
+  (dolist (participant (tp--transaction-participants-in-registration-order))
     (push participant tp--transaction-published-participants)
+    ;; Mark first so a stage that mutates and then signals remains rollbackable.
+    (setf (tp--transaction-participant-state participant) 'staged)
     (funcall (tp--transaction-participant-publish participant))))
 
 (defun tp--rollback-transaction-participants ()
   "Rollback published participants and return any failures."
   (let (failures)
     (dolist (participant tp--transaction-published-participants)
+      (unwind-protect
           (condition-case failure
               (funcall (tp--transaction-participant-rollback participant))
             ((error quit)
              (push (list 'participants
                          (tp--transaction-participant-key participant)
                          failure)
-               failures))))
+                   failures)))
+        (setf (tp--transaction-participant-state participant) 'rolled-back)))
+    (dolist (participant tp--transaction-participants)
+      (when (eq (tp--transaction-participant-state participant) 'prepared)
+        (setf (tp--transaction-participant-state participant) 'rolled-back)))
     (nreverse failures)))
 
+(defun tp--run-transaction-participant-precommits ()
+  "Run declared structured participant validators in registration order."
+  (dolist (participant (tp--transaction-participants-in-registration-order))
+    (when-let* ((function (tp--transaction-participant-precommit participant)))
+      (unless (tp--transaction-participant-precommit-function-p function)
+        (signal 'tp-reactive-error
+                (list :invalid-participant-precommit function)))
+      (funcall function))))
+
+(defun tp--commit-transaction-participants ()
+  "Commit participant states and queue their contained after-commit work."
+  (dolist (participant (tp--transaction-participants-in-registration-order))
+    (when (eq (tp--transaction-participant-state participant) 'staged)
+      (setf (tp--transaction-participant-state participant) 'committed)
+      (when-let* ((function
+                   (tp--transaction-participant-after-commit participant)))
+        (tp--enqueue-after-commit function)))))
+
 (defun tp--dequeue-dirty-binding ()
   "Return and remove the next queued dirty binding."
   (let (binding)
@@ -754,6 +867,391 @@ transaction."
                   tp--transaction-final-accept-function function)))
   (setq tp--transaction-final-accept-function function))
 
+(defun tp--transaction-v2-artifacts-enabled-p ()
+  "Return non-nil when the additive v2 shadow artifacts are enabled."
+  (pcase tp--transaction-artifact-mode
+    ('v1 nil)
+    ((or 'shadow 'v1+v2-shadow) t)
+    (_ (signal 'tp-transaction-contract-error
+               (list :artifact-mode tp--transaction-artifact-mode)))))
+
+(defun tp--transaction-current-outcome-cell ()
+  "Return the active transaction's caller-retainable one-slot outcome cell."
+  (unless tp--transaction-active
+    (signal 'tp-reactive-error (list :outcome-cell-outside-transaction)))
+  tp--transaction-outcome-cell)
+
+(defun tp--transaction-enter-phase (phase)
+  "Record the completed phase duration and enter PHASE."
+  (let ((now (float-time)))
+    (when (and tp--transaction-phase tp--transaction-phase-start)
+      (push (cons tp--transaction-phase
+                  (- now tp--transaction-phase-start))
+            tp--transaction-phase-timings))
+    (setq tp--transaction-phase phase
+          tp--transaction-phase-start now)))
+
+(defun tp--transaction-publish-outcome (outcome)
+  "Publish internal OUTCOME without changing the public transaction return."
+  (setq tp--transaction-outcome outcome
+        tp--last-transaction-outcome outcome)
+  (when (vectorp tp--transaction-outcome-cell)
+    (aset tp--transaction-outcome-cell 0 outcome))
+  (when tp--transaction-publication-batch
+    (setf (tp-publication-batch-candidate-outcome
+           tp--transaction-publication-batch)
+          outcome))
+  outcome)
+
+(defun tp--transaction-batch-journal-view (surface-journals)
+  "Return a fixed view vector over current journals and SURFACE-JOURNALS."
+  (vector tp--transaction-extensions
+          tp--transaction-signal-values
+          tp--transaction-binding-snapshots
+          tp--transaction-counter-start
+          tp--transaction-signal-commit-journal
+          surface-journals))
+
+(defun tp--transaction-begin-publication-batch
+    (batch-id entries surface-journals)
+  "Install BATCH-ID as the candidate for ENTRIES and SURFACE-JOURNALS."
+  (unless tp--transaction-active
+    (signal 'tp-reactive-error (list :batch-outside-transaction batch-id)))
+  (when tp--transaction-publication-batch
+    (signal 'tp-publication-state-error
+            (list :duplicate-transaction-batch batch-id)))
+  (when (tp--transaction-v2-artifacts-enabled-p)
+    (setq tp--transaction-publication-batch
+          (tp--publication-batch-prepare
+           :transaction-id tp--transaction-id
+           :batch-id batch-id
+           :entries entries
+           :participants
+           (vconcat (tp--transaction-participants-in-registration-order))
+           :journals (tp--transaction-batch-journal-view surface-journals)
+           :final-accept tp--transaction-final-accept-function
+           :diagnostics nil)))
+  tp--transaction-publication-batch)
+
+(defun tp--transaction-batch-transition (next)
+  "Move the active publication candidate to NEXT when one exists."
+  (when tp--transaction-publication-batch
+    (tp--publication-batch-transition
+     tp--transaction-publication-batch next)))
+
+(cl-defun tp--transaction-register-final-marker
+    (&key owner-key expected-token expected-version next-values inverse-values
+          slot-write-count operation-key)
+  "Register a bounded opaque marker for OWNER-KEY before precommit.
+EXPECTED-TOKEN and EXPECTED-VERSION bind owner state.  NEXT-VALUES and
+INVERSE-VALUES are prebuilt opaque payloads.  SLOT-WRITE-COUNT is checked
+against the trusted OPERATION-KEY descriptor and the transaction bound."
+  (unless (and tp--transaction-active
+               (memq tp--transaction-phase
+                     '(body recompute publication participants))
+               (not tp--transaction-final-markers-frozen-p))
+    (signal 'tp-final-marker-error
+            (list :registration-phase tp--transaction-phase)))
+  (when (>= tp--transaction-final-marker-count tp--final-marker-max-count)
+    (signal 'tp-final-marker-error
+            (list :marker-count tp--transaction-final-marker-count)))
+  (let ((duplicate nil))
+    (dotimes (index tp--transaction-final-marker-count)
+      (when (equal owner-key
+                   (aref tp--transaction-final-marker-owner-keys index))
+        (setq duplicate t)))
+    (when duplicate
+      (signal 'tp-final-marker-error (list :duplicate-owner-key owner-key))))
+  (let ((marker
+         (tp--final-accept-marker-create
+          :owner-key owner-key
+          :expected-token expected-token
+          :expected-version expected-version
+          :next-values next-values
+          :inverse-values inverse-values
+          :slot-write-count slot-write-count
+          :operation-key operation-key)))
+    (when (> (+ tp--transaction-final-marker-slot-writes slot-write-count)
+             tp--final-marker-max-slot-writes)
+      (signal 'tp-final-marker-error
+              (list :slot-write-bound
+                    tp--transaction-final-marker-slot-writes
+                    slot-write-count)))
+    (aset tp--transaction-final-marker-registry
+          tp--transaction-final-marker-count marker)
+    (aset tp--transaction-final-marker-owner-keys
+          tp--transaction-final-marker-count
+          (tp--copy-property-value owner-key))
+    (cl-incf tp--transaction-final-marker-count)
+    (cl-incf tp--transaction-final-marker-slot-writes slot-write-count)
+    marker))
+
+(defun tp--transaction-freeze-final-markers ()
+  "Validate and seal every marker before signal commit and final accept."
+  (when (and (> tp--transaction-final-marker-count 0)
+             (null tp--transaction-publication-batch))
+    (signal 'tp-final-marker-error (list :marker-without-publication-batch)))
+  (dotimes (index tp--transaction-final-marker-count)
+    (tp--final-accept-marker-validate
+     (aref tp--transaction-final-marker-registry index)))
+  (setq tp--transaction-final-markers-frozen-p t)
+  (when tp--transaction-publication-batch
+    (setf (tp-publication-batch-candidate-markers
+           tp--transaction-publication-batch)
+          (cons tp--transaction-final-marker-registry
+                tp--transaction-final-marker-count)))
+  tp--transaction-final-marker-count)
+
+(defun tp--transaction-sync-publication-batch ()
+  "Refresh fixed batch view slots after precommit and signal journaling."
+  (when tp--transaction-publication-batch
+    (setf (tp-publication-batch-candidate-final-accept
+           tp--transaction-publication-batch)
+          tp--transaction-final-accept-function)
+    (let ((journals
+           (tp-publication-batch-candidate-journals
+            tp--transaction-publication-batch)))
+      (when (vectorp journals)
+        (aset journals 4 tp--transaction-signal-commit-journal)))))
+
+(defun tp--transaction-prepare-success-outcome ()
+  "Preallocate the active batch's success evidence before final accept."
+  (when tp--transaction-publication-batch
+    (let ((candidate tp--transaction-publication-batch)
+          (text-operations 0)
+          (property-operations 0)
+          (touched-characters 0)
+          target-counts)
+      (dolist (entry (tp-publication-batch-candidate-entries candidate))
+        (let ((counts (tp-publication-target-entry-operation-counts entry)))
+          (unless counts
+            (signal 'tp-publication-binding-error
+                    (list :missing-operation-counts
+                          (tp-publication-target-entry-surface-id entry))))
+          (cl-incf text-operations (or (plist-get counts :text-operations) 0))
+          (cl-incf property-operations
+                   (or (plist-get counts :property-operations) 0))
+          (cl-incf touched-characters
+                   (or (plist-get counts :touched-characters) 0))
+          (push (tp--copy-property-value counts) target-counts)))
+      (setf
+       (tp-publication-batch-candidate-operation-counts candidate)
+       (list :targets
+             (length (tp-publication-batch-candidate-entries candidate))
+             :participants (length tp--transaction-participants)
+             :signals (length tp--transaction-signals)
+             :markers tp--transaction-final-marker-count
+             :text-operations text-operations
+             :property-operations property-operations
+             :touched-characters touched-characters
+             :target-counts (nreverse target-counts))
+       (tp-publication-batch-candidate-phase-timings candidate)
+       (nreverse (copy-sequence tp--transaction-phase-timings))
+       (tp-publication-batch-candidate-diagnostics candidate)
+       (tp--copy-property-value tp--transaction-contained-failures))
+      (setf (tp-publication-batch-candidate-success-outcome-draft candidate)
+            (tp--committed-success-outcome-draft
+             candidate
+             (tp-publication-batch-candidate-operation-counts candidate)
+             (tp-publication-batch-candidate-phase-timings candidate)
+             (tp-publication-batch-candidate-diagnostics candidate)
+             tp--transaction-final-marker-count)))))
+
+(defun tp--transaction-apply-one-final-marker (marker)
+  "Apply one prevalidated MARKER through its closed package primitive."
+  (funcall
+   (tp--final-marker-operation-apply
+    (tp-final-accept-marker-operation marker))
+   marker))
+
+(defun tp--transaction-restore-one-final-marker (marker)
+  "Restore one prevalidated MARKER through its closed package primitive."
+  (funcall
+   (tp--final-marker-operation-restore
+    (tp-final-accept-marker-operation marker))
+   marker))
+
+(defun tp--transaction-restore-final-marker-at (index failures-cell)
+  "Restore marker INDEX, then exhaustively continue using FAILURES-CELL."
+  (when (>= index 0)
+    (let ((marker (aref tp--transaction-final-marker-registry index)))
+      (unwind-protect
+          (when (memq (tp-final-accept-marker-state marker)
+                      '(applying applied))
+            (setf (tp-final-accept-marker-state marker) 'restoring)
+            (condition-case failure
+                (progn
+                  (tp--transaction-restore-one-final-marker marker)
+                  (setf (tp-final-accept-marker-state marker) 'restored))
+              ((error quit)
+               (setf (tp-final-accept-marker-state marker) 'restore-failed)
+               (aset
+                failures-cell 0
+                (cons (list 'final-markers
+                            (tp-final-accept-marker-owner-key marker)
+                            failure)
+                      (aref failures-cell 0))))))
+        ;; This cleanup runs even when a test or corrupted primitive exits by
+        ;; an arbitrary nonlocal throw, so no earlier applied marker is skipped.
+        (tp--transaction-restore-final-marker-at
+         (1- index) failures-cell)))))
+
+(defun tp--transaction-restore-applied-final-markers ()
+  "Reverse every applied marker and return contained restore failures."
+  (let ((index (1- tp--transaction-applied-final-marker-count))
+        (failures-cell (vector nil)))
+    (setq tp--transaction-applied-final-marker-count 0)
+    (tp--transaction-restore-final-marker-at index failures-cell)
+    (nreverse (aref failures-cell 0))))
+
+(defun tp--transaction-apply-final-markers ()
+  "Apply every sealed marker in registration order."
+  (dotimes (index tp--transaction-final-marker-count)
+    (let ((marker (aref tp--transaction-final-marker-registry index)))
+      ;; Count and mark first so mutate-then-signal is still reverse-restored.
+      (setq tp--transaction-applied-final-marker-count (1+ index))
+      (setf (tp-final-accept-marker-state marker) 'applying)
+      (tp--transaction-apply-one-final-marker marker)
+      (setf (tp-final-accept-marker-state marker) 'applied))))
+
+(defun tp--transaction-commit-final-markers ()
+  "Finalize marker state through fixed writes after successful accept."
+  (dotimes (index tp--transaction-final-marker-count)
+    (setf (tp-final-accept-marker-state
+           (aref tp--transaction-final-marker-registry index))
+          'committed))
+  (setq tp--transaction-applied-final-marker-count 0))
+
+(defun tp--transaction-run-final-accept ()
+  "Apply markers, invoke the existing single final accept, and finalize tags."
+  (tp--transaction-batch-transition 'final-accepting)
+  (let (accepted)
+    (unwind-protect
+        (progn
+          (tp--transaction-apply-final-markers)
+          (funcall tp--transaction-final-accept-function)
+          (setq accepted t))
+      (unless accepted
+        (setq tp--transaction-marker-restore-failures
+              (tp--transaction-restore-applied-final-markers))))
+    (when accepted
+      (tp--transaction-commit-final-markers)
+      (when tp--transaction-publication-batch
+        (let* ((candidate tp--transaction-publication-batch)
+               (outcome
+                (tp-publication-batch-candidate-success-outcome-draft
+                 candidate)))
+          ;; Every fallible validation and allocation happened before accept.
+          (setf (tp-publication-batch-candidate-state candidate) 'committed
+                (tp-publication-batch-candidate-resolution candidate) 'committed)
+          ;; The success tag is a read-only slot with one coordinator-owned
+          ;; fixed write after the existing final accept has returned.
+          (aset outcome tp--committed-success-outcome-tag-slot
+                'committed-success)
+          (tp--transaction-publish-outcome outcome))))))
+
+(defun tp--transaction-run-shadow-proof (phase)
+  "Compare v2 artifacts with the single v1 live result for PHASE."
+  (when (and tp--transaction-publication-batch
+             (tp--transaction-v2-artifacts-enabled-p))
+    (let ((ok t) results outcome-equivalent)
+      (dolist (entry
+               (tp-publication-batch-candidate-entries
+                tp--transaction-publication-batch))
+        (let ((validator (tp-publication-target-entry-shadow-validator entry)))
+          (condition-case failure
+              (let ((result (and validator (funcall validator entry phase))))
+                (setf (tp-publication-target-entry-shadow-actual entry) result
+                      (tp-publication-target-entry-shadow-proven-p entry)
+                      (and result (plist-get result :equivalent)))
+                (unless (tp-publication-target-entry-shadow-proven-p entry)
+                  (setq ok nil))
+                (when (eq phase 'rollback)
+                  (setf (tp-publication-target-entry-rollback-result entry)
+                        (if (plist-get result :equivalent) 'restored 'mismatch)
+                        (tp-publication-target-entry-post-rollback-state entry)
+                        (plist-get result :actual)))
+                (push result results))
+            ((error quit)
+             (setq ok nil)
+             (push (list :equivalent nil :failure failure) results)))))
+      (setq outcome-equivalent
+            (pcase phase
+              ('commit
+               (tp--committed-success-outcome-valid-for-p
+                tp--transaction-outcome tp--transaction-publication-batch))
+              ('rollback
+               (and tp--transaction-outcome
+                    (tp--publication-failure-outcome-valid-for-p
+                     tp--transaction-outcome
+                     tp--transaction-publication-batch)))))
+      (when (and (eq phase 'commit) (not outcome-equivalent))
+        (setq ok nil))
+      (let ((proof (list :phase phase :equivalent ok
+                         :outcome-equivalent outcome-equivalent
+                         :entries (nreverse results))))
+        (setf (tp-publication-batch-candidate-shadow-proof
+               tp--transaction-publication-batch)
+              proof)
+        (setq tp--last-shadow-proof
+              (list :phase phase :equivalent ok
+                    :outcome-equivalent outcome-equivalent
+                    :entry-count
+                    (length
+                     (tp-publication-batch-candidate-entries
+                      tp--transaction-publication-batch))))
+        (unless ok
+          (push (list 'shadow-proof phase proof)
+                tp--transaction-contained-failures))
+        proof))))
+
+(defun tp--transaction-finalize-rollback-shadow-outcome ()
+  "Correlate the failure outcome with the already compared rollback artifacts."
+  (when-let* ((candidate tp--transaction-publication-batch)
+              (proof (tp-publication-batch-candidate-shadow-proof candidate)))
+    (let* ((outcome-equivalent
+            (tp--publication-failure-outcome-valid-for-p
+             tp--transaction-outcome candidate))
+           (equivalent
+            (and (plist-get proof :equivalent) outcome-equivalent)))
+      (setq proof (plist-put proof :outcome-equivalent outcome-equivalent)
+            proof (plist-put proof :equivalent equivalent))
+      (setf (tp-publication-batch-candidate-shadow-proof candidate) proof)
+      (setq tp--last-shadow-proof
+            (list :phase 'rollback :equivalent equivalent
+                  :outcome-equivalent outcome-equivalent
+                  :entry-count
+                  (length (tp-publication-batch-candidate-entries candidate))))
+      (unless equivalent
+        (push (list 'shadow-proof 'rollback-outcome proof)
+              tp--transaction-contained-failures))
+      proof)))
+
+(defun tp--transaction-finish-rollback (primary-condition rollback-failures)
+  "Finalize failure evidence for PRIMARY-CONDITION and ROLLBACK-FAILURES."
+  (dotimes (index tp--transaction-final-marker-count)
+    (let ((marker (aref tp--transaction-final-marker-registry index)))
+      (when (eq (tp-final-accept-marker-state marker) 'prepared)
+        (setf (tp-final-accept-marker-state marker) 'rolled-back))))
+  (when tp--transaction-publication-batch
+    (let ((candidate tp--transaction-publication-batch))
+      (unless (tp--publication-batch-terminal-p candidate)
+        (if (eq (tp-publication-batch-candidate-state candidate) 'prepared)
+            (progn
+              (setf (tp-publication-batch-candidate-state candidate) 'discarded
+                    (tp-publication-batch-candidate-resolution candidate)
+                    'discarded))
+          (tp--publication-batch-transition candidate 'rolled-back)))
+      (tp--transaction-run-shadow-proof 'rollback)
+      (when (and primary-condition
+                 (eq (tp-publication-batch-candidate-state candidate)
+                     'rolled-back))
+        (tp--transaction-publish-outcome
+         (tp--publication-failure-outcome-create
+          candidate tp--transaction-phase primary-condition rollback-failures
+          tp--transaction-contained-failures))
+        (tp--transaction-finalize-rollback-shadow-outcome)))))
+
 (defun tp--run-contained-transaction-functions (phase functions)
   "Run postaccept PHASE FUNCTIONS and record contained failures."
   (dolist (function (tp--transaction-hook-functions functions))
@@ -846,10 +1344,11 @@ transaction."
 (defun tp--rollback-transaction-state (counter-snapshot)
   "Restore COUNTER-SNAPSHOT through every rollback phase.
 Return contained failures in phase order."
-  (let ((failures (tp--rollback-transaction-participants)))
+  (let ((failures (copy-sequence tp--transaction-marker-restore-failures)))
     (setq failures
           (append
            failures
+           (tp--rollback-transaction-participants)
            (tp--rollback-hook-phase
             'rollback-hooks tp--transaction-rollback-functions)
            (tp--rollback-signal-journal)))
@@ -893,8 +1392,14 @@ the primary condition data."
       (funcall function)
     (let (after-commit result
           (tp--transaction-contained-failures nil))
+      (setq tp--last-transaction-outcome nil
+            tp--last-shadow-proof nil)
       (setq result
             (let ((tp--transaction-active t)
+                  (tp--transaction-id (tp--next-transaction-id))
+                  (tp--transaction-phase 'body)
+                  (tp--transaction-phase-start (float-time))
+                  (tp--transaction-phase-timings nil)
                   (tp--transaction-signal-values
                    (make-hash-table :test #'eq))
                   (tp--transaction-signals nil)
@@ -909,8 +1414,21 @@ the primary condition data."
                   (tp--transaction-after-commit-callbacks nil)
                   (tp--transaction-participants nil)
                   (tp--transaction-participant-keys nil)
+                  (tp--transaction-participant-order 0)
                   (tp--transaction-published-participants nil)
                   (tp--transaction-signal-commit-journal nil)
+                  (tp--transaction-publication-batch nil)
+                  (tp--transaction-final-marker-registry
+                   (make-vector tp--final-marker-max-count nil))
+                  (tp--transaction-final-marker-owner-keys
+                   (make-vector tp--final-marker-max-count nil))
+                  (tp--transaction-final-marker-count 0)
+                  (tp--transaction-final-marker-slot-writes 0)
+                  (tp--transaction-final-markers-frozen-p nil)
+                  (tp--transaction-applied-final-marker-count 0)
+                  (tp--transaction-marker-restore-failures nil)
+                  (tp--transaction-outcome nil)
+                  (tp--transaction-outcome-cell (vector nil))
                   (tp--transaction-final-accept-function
                    #'tp--transaction-noop-final-accept)
                   (counter-snapshot (copy-sequence tp--reactive-counters))
@@ -922,11 +1440,24 @@ the primary condition data."
                   (condition-case condition
                       (progn
                         (setq transaction-result (funcall function))
+                        (tp--transaction-enter-phase 'recompute)
                         (tp--flush-dirty-bindings)
+                        (tp--transaction-enter-phase 'publication)
                         (run-hooks 'tp--transaction-publish-functions)
+                        (tp--transaction-batch-transition 'participants)
+                        (tp--transaction-enter-phase 'participants)
                         (tp--publish-transaction-participants)
+                        (tp--transaction-batch-transition 'precommit)
+                        (tp--transaction-enter-phase 'precommit)
+                        (tp--run-transaction-participant-precommits)
                         (tp--run-transaction-precommit-functions)
+                        (tp--transaction-freeze-final-markers)
+                        (tp--transaction-sync-publication-batch)
+                        (tp--transaction-enter-phase 'signal-commit)
                         (tp--commit-signal-values)
+                        (tp--transaction-sync-publication-batch)
+                        (tp--transaction-enter-phase 'final-accept)
+                        (tp--transaction-prepare-success-outcome)
                         (condition-case deferred-quit
                             (progn
                               (let ((inhibit-quit t)
@@ -941,9 +1472,10 @@ the primary condition data."
                                          (list
                                           :invalid-final-accept-function
                                           tp--transaction-final-accept-function)))
-                                      (funcall
+                                      (tp--transaction-run-final-accept)
-                                       tp--transaction-final-accept-function)
                                       (setq success t)
+                                      (tp--commit-transaction-participants)
+                                      (tp--transaction-run-shadow-proof 'commit)
                                       (when quit-flag
                                         (setq pending-quit t
                                               quit-flag nil))
@@ -976,9 +1508,14 @@ the primary condition data."
                   (let ((inhibit-quit t)
                         (quit-flag nil))
                     (unwind-protect
-                        (setq rollback-failures
+                        (progn
+                          (setq tp--transaction-phase
+                                (or tp--transaction-phase 'rollback)
+                                rollback-failures
                                 (tp--rollback-transaction-state
                                  counter-snapshot))
+                          (tp--transaction-finish-rollback
+                           primary-condition rollback-failures))
                       (setq quit-flag nil)))))
               (when primary-condition
                 (tp--resignal-transaction-primary

tp-surface.el

@@ -121,7 +121,7 @@ producer result to the active prepare transaction."
   id buffer start end boundary-policy live stale surfaces candidate-context)
 
 (cl-defstruct (tp--surface-mount (:constructor tp--make-surface-mount))
-  object start end tags capability anchor)
+  id object start end tags capability anchor)
 
 (defun tp--mount-position (position)
   "Return numeric POSITION for a marker or coordinate mount endpoint."
@@ -144,6 +144,7 @@ producer result to the active prepare transaction."
 
 (defvar tp--surface-id-counter 0)
 (defvar tp--object-id-counter 0)
+(defvar tp--mount-id-counter 0)
 (defvar tp--anchor-id-counter 0)
 (defvar tp--surface-transaction-id 0)
 (defvar tp--surfaces (make-hash-table :test #'eql :weakness 'value))
@@ -297,6 +298,7 @@ Use `tp-surface-result-create' for ordinary caller-owned plans."
 PLAN must preserve the committed TP object topology and contain the new text
 leaf.  RENDERED is the final propertized text and RANGES are candidate-local
 content attachments already associated with PLAN's text leaf.
+CLIENT-STATE is opaque owner state and FULL-SURFACE-P asserts complete scope.
 PROPERTY-CONTRIBUTIONS is an ordered list of relative `:start', `:end', and
 `:props' plists.  TP composes them over RENDERED using registered property
 merge policy before diff and publication.  This entry point is intentionally
@@ -478,8 +480,8 @@ Each contribution contains `:start', `:end', and direct `:props'."
     object))
 
 (defun tp-object-ensure-at (context parent key kind position)
-  "Return candidate identity at explicit sibling POSITION below PARENT.
+  "Return CONTEXT identity at explicit sibling POSITION below PARENT.
-KEYED objects retain their normal explicit-key identity; POSITION is used only
+KEY and KIND identify normal keyed objects; POSITION is used only
 for anonymous objects.  This is the compiled-topology entry point and does not
 depend on replaying preceding siblings to discover the same slot."
   (tp--validate-prepare-context context)
@@ -1283,7 +1285,7 @@ When RELATIVE is non-nil, return offsets from the surface start."
                  (substring-no-properties text))))
 
 (defun tp--scope-outside-separator-equivalent-p (left right)
-  "Return non-nil when scoped outside gaps differ only by line separators.
+  "Return non-nil when scoped outside gaps LEFT and RIGHT are separators.
 Logical Ebox owners may absorb a newline between two owned rendered runs when
 one candidate line grows or shrinks.  Treating that delimiter as part of the
 owner preserves scoped publication while still rejecting every non-separator
@@ -1375,7 +1377,8 @@ MOUNT-SPECS describe the candidate object ranges and OPTIONS controls mismatch."
 
 (defun tp--prepare-retained-content
     (surface candidate context scope-objects scope-options initial)
-  "Prepare CANDIDATE without traversing or rendering its unchanged plan.
+  "Prepare CANDIDATE for SURFACE in CONTEXT without traversing its plan.
+SCOPE-OBJECTS and SCOPE-OPTIONS constrain publication; INITIAL must be nil.
 The candidate is valid only when its plan has the same three-level content
 surface topology as the committed plan.  Its text and content attachments are
 still validated and published through the ordinary TP transaction phases."
@@ -1524,6 +1527,7 @@ END-P selects the right boundary when POSITION lies inside a replacement."
 (defun tp--commit-batch-retained-mount-state
     (surface mount-specs context target-extent)
   "Return exact coordinate updates when SURFACE can retain MOUNT-SPECS.
+CONTEXT authenticates candidate objects and TARGET-EXTENT bounds coordinates.
 The returned cons distinguishes an exact empty update set from a proof miss."
   (let ((base (marker-position (tp--surface-start surface)))
         (mounts (tp--surface-mounts surface))
@@ -1974,6 +1978,9 @@ MOUNT-SPECS and SURFACE provide ranges for PROPERTIES."
     (&key base-revision target-revision base-extent target-extent
           patches coordinate-patches client-state)
   "Create a validated precomputed content commit batch.
+BASE-REVISION and TARGET-REVISION bind the transition; BASE-EXTENT and
+TARGET-EXTENT bind its coordinates.  COORDINATE-PATCHES project retained
+mounts, and CLIENT-STATE is opaque owner state.
 PATCHES are ordered plists containing :old-start, :old-end, :new-start,
 :new-end, and a propertized :replacement string."
   (unless (and (integerp base-revision) (>= base-revision 0)
@@ -2041,6 +2048,7 @@ PATCHES are ordered plists containing :old-start, :old-end, :new-start,
              (client-state nil client-state-p)
              reuse-mount-projection)
   "Return one authenticated producer result carrying precomputed BATCH.
+CONTEXT must be the active prepare context.
 When MOUNT-SPECS is supplied, it is the complete target coordinate projection
 for the batch.  Each spec contains `:object', `:start', `:end', and optional
 `:tags'.  When CLIENT-STATE is supplied, it replaces BATCH's defensive state
@@ -2497,6 +2505,60 @@ caller reads the scalar summary from the surface instead."
                     (tp--surface-mount-tags mount)))
             (tp--surface-mounts surface))))
 
+(defun tp--ensure-surface-mount-id (mount)
+  "Return MOUNT's stable private id, allocating it before publication if absent."
+  (or (tp--surface-mount-id mount)
+      (setf (tp--surface-mount-id mount) (cl-incf tp--mount-id-counter))))
+
+(defun tp--mount-spec-matches-live-p (spec mount capability)
+  "Return non-nil when SPEC denotes live MOUNT for CAPABILITY."
+  (and (eq (plist-get spec :object) (tp--surface-mount-object mount))
+       (eq capability (tp--surface-mount-capability mount))
+       (eq (plist-get spec :anchor) (tp--surface-mount-anchor mount))
+       (equal (plist-get spec :tags) (tp--surface-mount-tags mount))))
+
+(defun tp--assign-prepared-mount-ids (prepared)
+  "Bind PREPARED mount specs to stable live or fresh private mount ids."
+  (let* ((surface (tp--prepared-surface-surface prepared))
+         (capability (tp--surface-capability surface))
+         (live (tp--surface-mounts surface))
+         (live-by-object (tp--surface-mount-index surface))
+         (used (make-hash-table :test #'eq)))
+    (if (tp--prepared-surface-retained-mount-state-p prepared)
+        (dolist (mount live) (tp--ensure-surface-mount-id mount))
+      (setf
+       (tp--prepared-surface-mount-specs prepared)
+       (mapcar
+        (lambda (spec)
+          (let ((match
+                 (cl-find-if
+                  (lambda (mount)
+                    (and (not (gethash mount used))
+                         (tp--mount-spec-matches-live-p
+                          spec mount capability)))
+                  (gethash (plist-get spec :object) live-by-object))))
+            (when match (puthash match t used))
+            (plist-put
+             spec :mount-id
+             (if match
+                 (tp--ensure-surface-mount-id match)
+               (cl-incf tp--mount-id-counter)))))
+        (tp--prepared-surface-mount-specs prepared))))
+    prepared))
+
+(defun tp--prepared-target-mount-ids (prepared)
+  "Return PREPARED's exact ordered target mount identities."
+  (if (tp--prepared-surface-retained-mount-state-p prepared)
+      (mapcar #'tp--ensure-surface-mount-id
+              (tp--surface-mounts
+               (tp--prepared-surface-surface prepared)))
+    (mapcar (lambda (spec) (plist-get spec :mount-id))
+            (tp--prepared-surface-mount-specs prepared))))
+
+(defun tp--live-mount-ids (surface)
+  "Return SURFACE's exact ordered private mount identities."
+  (mapcar #'tp--ensure-surface-mount-id (tp--surface-mounts surface)))
+
 (defun tp--content-output-equal-p (prepared)
   "Return non-nil when PREPARED already matches its content mount."
   (let ((surface (tp--prepared-surface-surface prepared)))
@@ -2691,6 +2753,8 @@ When SCOPED is non-nil, inspect only RANGES, including an empty set."
     (mapcar
      (lambda (spec)
        (tp--make-surface-mount
+        :id (or (plist-get spec :mount-id)
+                (cl-incf tp--mount-id-counter))
         :object (plist-get spec :object)
         :start (if coordinate-p
                    (+ base (plist-get spec :start))
@@ -2709,6 +2773,8 @@ When SCOPED is non-nil, inspect only RANGES, including an empty set."
    (lambda (spec)
      (let ((anchor (plist-get spec :anchor)))
        (tp--make-surface-mount
+        :id (or (plist-get spec :mount-id)
+                (cl-incf tp--mount-id-counter))
         :object (plist-get spec :object)
         :start (tp--anchor-start anchor) :end (tp--anchor-end anchor)
         :tags (plist-get spec :tags) :capability 'properties :anchor anchor)))
@@ -2898,7 +2964,7 @@ Return the number of text operations."
     count))
 
 (defun tp--publish-retained-content-text (prepared)
-  "Publish a full-surface retained content candidate in one text operation.
+  "Publish PREPARED retained content in one full-surface text operation.
 The candidate proof guarantees that the retained surface scope is exactly the
 surface range.  RENDERED already carries its final text properties, so a
 delete/insert preserves the authoritative property runs without constructing
@@ -3299,6 +3365,252 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback."
                    (tp--prepared-surface-surface prepared))))
           prepared-list))
 
+(defun tp--shadow-object-ids (objects)
+  "Return stable sorted ids from OBJECTS, a list or path-indexed table."
+  (let (ids)
+    (if (hash-table-p objects)
+        (maphash (lambda (_path object)
+                   (push (tp--surface-object-id object) ids))
+                 objects)
+      (dolist (object objects)
+        (push (tp--surface-object-id object) ids)))
+    (sort ids #'<)))
+
+(defun tp--shadow-ledger-spec-signature (specs)
+  "Return the deterministic target signature for ledger SPECS."
+  (mapcar
+   (lambda (spec)
+     (list :start (plist-get spec :start)
+           :end (plist-get spec :end)
+           :property (plist-get spec :property)
+           :baseline-present (plist-get spec :baseline-present)
+           :baseline-value (plist-get spec :baseline-value)
+           :published-present (plist-get spec :published-present)
+           :published-value (plist-get spec :published-value)
+           :anchors (plist-get spec :anchors)))
+   specs))
+
+(defun tp--shadow-live-ledger-signature (ledger)
+  "Return the deterministic committed signature for live LEDGER entries."
+  (mapcar
+   (lambda (entry)
+     (list :start (tp--ledger-position (tp--property-ledger-start entry))
+           :end (tp--ledger-position (tp--property-ledger-end entry))
+           :property (tp--property-ledger-property entry)
+           :baseline-present (tp--property-ledger-baseline-present entry)
+           :baseline-value (tp--property-ledger-baseline-value entry)
+           :published-present (tp--property-ledger-published-present entry)
+           :published-value (tp--property-ledger-published-value entry)
+           :anchors (tp--property-ledger-anchors entry)))
+   ledger))
+
+(defun tp--shadow-apply-commit-batch-to-string (string batch)
+  "Return STRING with BATCH patches applied without touching a buffer."
+  (let ((result (copy-sequence string)))
+    (dolist (patch (reverse (tp-commit-batch-patches batch)))
+      (setq result
+            (concat (substring result 0 (plist-get patch :old-start))
+                    (plist-get patch :replacement)
+                    (substring result (plist-get patch :old-end)))))
+    result))
+
+(defun tp--shadow-apply-property-operations-to-string
+    (string base operations)
+  "Return STRING with absolute property OPERATIONS rebased from BASE."
+  (let ((result (copy-sequence string)))
+    (dolist (operation operations)
+      (let ((start (- (plist-get operation :start) base))
+            (end (- (plist-get operation :end) base))
+            (property (plist-get operation :property)))
+        (if (plist-get operation :present)
+            (put-text-property start end property
+                               (plist-get operation :value) result)
+          (remove-list-of-text-properties start end (list property) result))))
+    result))
+
+(defun tp--shadow-surface-output (surface)
+  "Return SURFACE's current text and direct properties as one snapshot."
+  (pcase-let ((`(,start . ,end) (tp--surface-range surface)))
+    (with-current-buffer (tp--surface-buffer surface)
+      (buffer-substring start end))))
+
+(defun tp--shadow-target-output (prepared old-output)
+  "Return PREPARED's expected publication output from OLD-OUTPUT."
+  (let ((surface (tp--prepared-surface-surface prepared)))
+    (if (eq (tp--surface-capability surface) 'content)
+        (if-let* ((batch (tp--prepared-surface-commit-batch prepared)))
+            (tp--shadow-apply-commit-batch-to-string old-output batch)
+          (copy-sequence (tp--prepared-surface-rendered prepared)))
+      (pcase-let ((`(,start . ,_end) (tp--surface-range surface)))
+        (tp--shadow-apply-property-operations-to-string
+         old-output start
+         (tp--prepared-surface-property-operations prepared))))))
+
+(defun tp--shadow-view-point (views buffer)
+  "Return BUFFER's numeric point snapshot from transaction VIEWS."
+  (when-let* ((state (cl-find buffer views :key #'car :test #'eq)))
+    (marker-position (cadr state))))
+
+(defun tp--shadow-prepared-diff (prepared)
+  "Return PREPARED's deterministic v2 diff artifact."
+  (cond
+   ((tp--prepared-surface-commit-batch prepared)
+    (let ((batch (tp--prepared-surface-commit-batch prepared)))
+      (list :kind 'commit-batch
+            :patches (tp-commit-batch-patches batch)
+            :coordinate-patches (tp-commit-batch-coordinate-patches batch))))
+   ((and (tp--prepared-surface-scope-objects prepared)
+         (not (tp--prepared-surface-scope-fallback prepared)))
+    (list :kind 'scoped
+          :patches (tp--prepared-surface-scope-patches prepared)))
+   (t
+    (list :kind 'full
+          :target-extent
+          (and (tp--prepared-surface-rendered prepared)
+               (length (tp--prepared-surface-rendered prepared)))))))
+
+(defun tp--shadow-artifact-equal-p (expected actual)
+  "Return non-nil when EXPECTED and ACTUAL publication artifacts are equal."
+  (and (eq (plist-get expected :buffer) (plist-get actual :buffer))
+       (= (plist-get expected :revision) (plist-get actual :revision))
+       (eq (plist-get expected :plan) (plist-get actual :plan))
+       (eq (plist-get expected :client-state)
+           (plist-get actual :client-state))
+       (equal (plist-get expected :object-ids)
+              (plist-get actual :object-ids))
+       (equal (plist-get expected :mount-ids)
+              (plist-get actual :mount-ids))
+       (equal (plist-get expected :mounts) (plist-get actual :mounts))
+       (equal (plist-get expected :ledger) (plist-get actual :ledger))
+       (= (plist-get expected :point) (plist-get actual :point))
+       (equal-including-properties
+        (plist-get expected :output) (plist-get actual :output))))
+
+(defun tp--shadow-current-artifact (surface)
+  "Return a normalized read-only artifact for current SURFACE state."
+  (list :buffer (tp--surface-buffer surface)
+        :revision (tp--surface-revision surface)
+        :plan (tp--surface-plan surface)
+        :client-state (tp--surface-client-state surface)
+        :object-ids (tp--shadow-object-ids (tp--surface-objects surface))
+        :mount-ids (tp--live-mount-ids surface)
+        :mounts (tp--live-mount-signature surface)
+        :ledger (tp--shadow-live-ledger-signature (tp--surface-ledger surface))
+        :point (with-current-buffer (tp--surface-buffer surface) (point))
+        :output (tp--shadow-surface-output surface)))
+
+(defun tp--surface-shadow-target-entry
+    (prepared snapshot journals views batch-id)
+  "Build a BATCH-ID target view over PREPARED and SNAPSHOT.
+JOURNALS and VIEWS are exact references to the existing v1 rollback state."
+  (let* ((prepared (tp--assign-prepared-mount-ids prepared))
+         (surface (tp--prepared-surface-surface prepared))
+         (buffer (tp--surface-buffer surface))
+         (old-output (tp--shadow-surface-output surface))
+         (old-mounts (tp--live-mount-signature surface))
+         (old-ledger
+          (tp--shadow-live-ledger-signature
+           (tp--surface-snapshot-ledger snapshot)))
+         (point (tp--shadow-view-point views buffer))
+         (commit-expected
+          (list :buffer buffer
+                :revision (1+ (tp--surface-snapshot-revision snapshot))
+                :plan (tp--prepared-surface-plan prepared)
+                :client-state (tp--prepared-surface-client-state prepared)
+                :object-ids
+                (tp--shadow-object-ids
+                 (tp--prepared-surface-objects prepared))
+                :mount-ids (tp--prepared-target-mount-ids prepared)
+                :mounts (tp--prepared-mount-signature prepared)
+                :ledger
+                (tp--shadow-ledger-spec-signature
+                 (tp--prepared-surface-ledger-specs prepared))
+                :point point
+                :output (tp--shadow-target-output prepared old-output)))
+         (rollback-expected
+          (list :buffer buffer
+                :revision (tp--surface-snapshot-revision snapshot)
+                :plan (tp--surface-snapshot-plan snapshot)
+                :client-state (tp--surface-snapshot-client-state snapshot)
+                :object-ids
+                (tp--shadow-object-ids
+                 (tp--surface-snapshot-objects snapshot))
+                :mount-ids
+                (mapcar #'tp--ensure-surface-mount-id
+                        (tp--surface-snapshot-mounts snapshot))
+                :mounts old-mounts
+                :ledger old-ledger
+                :point point
+                :output old-output))
+         (expected (list :commit commit-expected
+                         :rollback rollback-expected)))
+    (tp--publication-target-entry-create
+     :transaction-id tp--transaction-id
+     :batch-id batch-id
+     :candidate-id (tp--next-publication-candidate-id)
+     :surface-id (tp--surface-id surface)
+     :mount-ids (tp--prepared-target-mount-ids prepared)
+     :buffer buffer
+     :old-revision (tp--surface-snapshot-revision snapshot)
+     :new-revision (1+ (tp--surface-snapshot-revision snapshot))
+     :plan (tp--prepared-surface-plan prepared)
+     :diff (tp--shadow-prepared-diff prepared)
+     :ledger (tp--prepared-surface-ledger-specs prepared)
+     :objects (tp--prepared-surface-objects prepared)
+     :ranges (tp--prepared-surface-mount-specs prepared)
+     :client-state (tp--prepared-surface-client-state prepared)
+     :rollback-snapshot (vector prepared snapshot journals views)
+     :authority-token (make-symbol "tp-publication-entry-authority")
+     :mapping-generation tp--surface-transaction-id
+     :shadow-expected expected
+     :shadow-validator
+     (lambda (_entry phase)
+       (let* ((target (plist-get expected
+                                 (if (eq phase 'commit)
+                                     :commit
+                                   :rollback)))
+              (actual (tp--shadow-current-artifact surface)))
+         (list :equivalent (tp--shadow-artifact-equal-p target actual)
+               :surface-id (tp--surface-id surface)
+               :expected target :actual actual))))))
+
+(defun tp--surface-shadow-target-entries
+    (prepared snapshots journals views batch-id)
+  "Return BATCH-ID entries for PREPARED using SNAPSHOTS, JOURNALS, and VIEWS."
+  (mapcar
+   (lambda (candidate)
+     (let ((snapshot (cdr (assq candidate snapshots))))
+       (unless snapshot
+         (signal 'tp-surface-error (list :missing-shadow-snapshot candidate)))
+       (tp--surface-shadow-target-entry
+        candidate snapshot journals views batch-id)))
+   prepared))
+
+(defun tp--surface-record-publication-operation-counts (prepared)
+  "Record PREPARED's actual v1 report counts into its exact batch entry."
+  (when tp--transaction-publication-batch
+    (let* ((surface (tp--prepared-surface-surface prepared))
+           (entry
+            (cl-find
+             (tp--surface-id surface)
+             (tp-publication-batch-candidate-entries
+              tp--transaction-publication-batch)
+             :key #'tp-publication-target-entry-surface-id :test #'equal))
+           (report (tp--prepared-surface-report prepared)))
+      (unless (and entry report)
+        (signal 'tp-publication-binding-error
+                (list :missing-publication-report (tp--surface-id surface))))
+      (setf
+       (tp-publication-target-entry-operation-counts entry)
+       (list :surface-id (tp--surface-id surface)
+             :old-revision (plist-get report :old-revision)
+             :new-revision (plist-get report :new-revision)
+             :mapping-generation tp--surface-transaction-id
+             :text-operations (or (plist-get report :text-operations) 0)
+             :property-operations
+             (or (plist-get report :property-operations) 0)
+             :touched-characters (or (plist-get report :touched-characters) 0))))))
+
 (defun tp--surface-publish-transaction ()
   "Prepare journals and publish every queued changed surface atomically."
   (let* ((state (tp--surface-extension-state))
@@ -3319,9 +3631,18 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback."
         (puthash 'surface-transaction-id-before
                  tp--surface-transaction-id state)
         (cl-incf tp--surface-transaction-id)
+        (when (tp--transaction-v2-artifacts-enabled-p)
+          (let* ((batch-id (tp--next-publication-batch-id))
+                 (entries
+                  (tp--surface-shadow-target-entries
+                   prepared snapshots journals views batch-id)))
+            (tp--transaction-begin-publication-batch
+             batch-id entries state)
+            (tp--transaction-batch-transition 'staged)))
         (let ((tp--surface-publishing t))
           (dolist (candidate prepared)
-            (tp--publish-one-surface candidate)))))))
+            (tp--publish-one-surface candidate)
+            (tp--surface-record-publication-operation-counts candidate)))))))
 
 (defun tp--surface-precommit-step (step state)
   "Report precommit STEP for transaction STATE."
@@ -3329,7 +3650,7 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback."
     (funcall tp--surface-precommit-step-function step state)))
 
 (defun tp--validate-retained-batch-precommit (prepared snapshot)
-  "Validate PREPARED retained batch from constant-time committed identities."
+  "Validate PREPARED retained batch against committed SNAPSHOT identities."
   (let* ((surface (tp--prepared-surface-surface prepared))
          (batch (tp--prepared-surface-commit-batch prepared))
          (mounts (tp--surface-mounts surface))

tp-transaction.el

@@ -0,0 +1,778 @@
+;;; tp-transaction.el --- Additive publication transaction contracts -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Geekinney
+
+;; Author: Geekinney (kinneyzhang666@gmail.com)
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3 of
+;; the License, or (at your option) any later version.
+
+;;; Commentary:
+
+;; Internal immutable artifacts and one-shot state machines used to shadow TP's
+;; v1 publication coordinator.  This module owns no live writer and never edits
+;; a buffer.  `tp-reactive' drives the state machine, while `tp-surface' supplies
+;; exact target entries backed by the v1 prepare journals and snapshots.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'tp-core)
+
+(define-error 'tp-transaction-contract-error
+  "Invalid TP publication transaction contract")
+(define-error 'tp-publication-binding-error
+  "TP publication artifact binding mismatch"
+  'tp-transaction-contract-error)
+(define-error 'tp-publication-state-error
+  "Invalid TP publication artifact state transition"
+  'tp-transaction-contract-error)
+(define-error 'tp-final-marker-error
+  "Invalid TP final-accept marker"
+  'tp-transaction-contract-error)
+
+(defconst tp-transaction-protocol 'tp-transaction-protocol-v1+v2
+  "Transaction protocol implemented by this TP package version.")
+
+(defconst tp--publication-batch-transitions
+  '((prepared staged rolled-back discarded)
+    (staged participants rolled-back)
+    (participants precommit rolled-back)
+    (precommit final-accepting rolled-back)
+    (final-accepting committed rolled-back))
+  "Allowed one-way state transitions for publication batch candidates.")
+
+(defconst tp--publication-batch-terminal-states
+  '(committed rolled-back discarded)
+  "Terminal publication batch candidate states.")
+
+(defconst tp--final-marker-max-count 8
+  "Maximum number of opaque final markers in one transaction.")
+
+(defconst tp--final-marker-max-slot-writes 16
+  "Maximum total fixed marker slot writes in one transaction.")
+
+(defvar tp--transaction-id-counter 0)
+(defvar tp--publication-batch-id-counter 0)
+(defvar tp--publication-candidate-id-counter 0)
+(defvar tp--final-accept-id-counter 0)
+
+(defun tp--next-transaction-id ()
+  "Return a fresh monotonic internal transaction identifier."
+  (cl-incf tp--transaction-id-counter))
+
+(defun tp--next-publication-batch-id ()
+  "Return a fresh monotonic publication batch identifier."
+  (cl-incf tp--publication-batch-id-counter))
+
+(defun tp--next-publication-candidate-id ()
+  "Return a fresh monotonic target candidate identifier."
+  (cl-incf tp--publication-candidate-id-counter))
+
+(defun tp--next-final-accept-id ()
+  "Return a fresh monotonic final-accept identifier."
+  (cl-incf tp--final-accept-id-counter))
+
+(defun tp--proper-unique-list-p (items)
+  "Return non-nil when ITEMS is a proper list with no equal duplicates."
+  (and (proper-list-p items)
+       (let (seen (unique t))
+         (dolist (item items unique)
+           (if (member item seen)
+               (setq unique nil)
+             (push item seen))))))
+
+(cl-defstruct (tp-publication-target-entry
+               (:constructor tp--make-publication-target-entry)
+               (:copier nil))
+  "One exact, immutable target binding in a publication candidate."
+  (transaction-id nil :read-only t)
+  (batch-id nil :read-only t)
+  (candidate-id nil :read-only t)
+  (surface-id nil :read-only t)
+  (mount-ids nil :read-only t)
+  (buffer nil :read-only t)
+  (old-revision nil :read-only t)
+  (new-revision nil :read-only t)
+  (plan nil :read-only t)
+  (diff nil :read-only t)
+  (ledger nil :read-only t)
+  (objects nil :read-only t)
+  (ranges nil :read-only t)
+  (client-state nil :read-only t)
+  (rollback-snapshot nil :read-only t)
+  (authority-token nil :read-only t)
+  (mapping-generation nil :read-only t)
+  operation-counts
+  (shadow-expected nil :read-only t)
+  (shadow-validator nil :read-only t)
+  rollback-result post-rollback-state shadow-actual shadow-proven-p)
+
+(cl-defun tp--publication-target-entry-create
+    (&key transaction-id batch-id candidate-id surface-id mount-ids buffer
+          old-revision new-revision plan diff ledger objects ranges client-state
+          rollback-snapshot authority-token mapping-generation shadow-expected
+          shadow-validator operation-counts)
+  "Create an exact TRANSACTION-ID and BATCH-ID target binding.
+CANDIDATE-ID, SURFACE-ID, MOUNT-IDS, BUFFER, OLD-REVISION, NEW-REVISION, PLAN,
+DIFF, LEDGER, OBJECTS, RANGES, CLIENT-STATE, ROLLBACK-SNAPSHOT, and
+AUTHORITY-TOKEN describe the target.  MAPPING-GENERATION is optional.
+OPERATION-COUNTS is filled from the v1 report.  SHADOW-EXPECTED and
+SHADOW-VALIDATOR are private comparison artifacts."
+  (unless (and transaction-id batch-id candidate-id surface-id
+               (bufferp buffer) (buffer-live-p buffer)
+               (integerp old-revision) (>= old-revision 0)
+               (integerp new-revision) (= new-revision (1+ old-revision))
+               (tp--proper-unique-list-p mount-ids)
+               authority-token
+               (or (null shadow-validator) (functionp shadow-validator)))
+    (signal 'tp-publication-binding-error
+            (list :target-entry transaction-id batch-id candidate-id surface-id
+                  buffer old-revision new-revision mount-ids authority-token)))
+  (tp--make-publication-target-entry
+   :transaction-id transaction-id
+   :batch-id batch-id
+   :candidate-id candidate-id
+   :surface-id (tp--copy-property-value surface-id)
+   :mount-ids (tp--copy-property-value mount-ids)
+   :buffer buffer
+   :old-revision old-revision
+   :new-revision new-revision
+   :plan plan
+   :diff (tp--copy-property-value diff)
+   :ledger ledger
+   :objects objects
+   :ranges ranges
+   :client-state (tp--copy-property-value client-state)
+   :rollback-snapshot rollback-snapshot
+   :authority-token authority-token
+   :mapping-generation mapping-generation
+   :operation-counts (tp--copy-property-value operation-counts)
+   :shadow-expected shadow-expected
+   :shadow-validator shadow-validator))
+
+(cl-defstruct (tp-publication-outcome-entry
+               (:constructor tp--make-publication-outcome-entry)
+               (:copier nil))
+  "Frozen observational binding copied from one target entry."
+  (batch-id nil :read-only t)
+  (candidate-id nil :read-only t)
+  (surface-id nil :read-only t)
+  (mount-ids nil :read-only t)
+  (buffer nil :read-only t)
+  (authority-token nil :read-only t)
+  (old-revision nil :read-only t)
+  (new-revision nil :read-only t)
+  (mapping-generation nil :read-only t)
+  (operation-counts nil :read-only t))
+
+(defun tp--publication-outcome-entry-from-target (entry)
+  "Return an observational outcome entry frozen from target ENTRY."
+  (tp--make-publication-outcome-entry
+   :batch-id (tp-publication-target-entry-batch-id entry)
+   :candidate-id (tp-publication-target-entry-candidate-id entry)
+   :surface-id
+   (tp--copy-property-value (tp-publication-target-entry-surface-id entry))
+   :mount-ids
+   (tp--copy-property-value (tp-publication-target-entry-mount-ids entry))
+   :buffer (tp-publication-target-entry-buffer entry)
+   :authority-token (tp-publication-target-entry-authority-token entry)
+   :old-revision (tp-publication-target-entry-old-revision entry)
+   :new-revision (tp-publication-target-entry-new-revision entry)
+   :mapping-generation
+   (tp-publication-target-entry-mapping-generation entry)
+   :operation-counts
+   (tp--copy-property-value
+    (tp-publication-target-entry-operation-counts entry))))
+
+(cl-defstruct (tp-committed-success-outcome
+               (:constructor tp--make-committed-success-outcome)
+               (:copier nil))
+  "Preallocated immutable evidence finalized only after final accept."
+  (tag nil :read-only t)
+  (transaction-id nil :read-only t)
+  (final-accept-id nil :read-only t)
+  (batch-id nil :read-only t)
+  (entries nil :read-only t)
+  (mapping-generation nil :read-only t)
+  (operation-counts nil :read-only t)
+  (phase-timings nil :read-only t)
+  (diagnostics nil :read-only t)
+  (marker-count nil :read-only t))
+
+(defconst tp--committed-success-outcome-tag-slot 1
+  "Private record offset for the sole postaccept success-tag write.")
+
+(cl-defstruct (tp-publication-failure-outcome
+               (:constructor tp--make-publication-failure-outcome)
+               (:copier nil))
+  "Immutable observational evidence built after publication rollback."
+  (tag 'publication-failure :read-only t)
+  (transaction-id nil :read-only t)
+  (batch-id nil :read-only t)
+  (failure-stage nil :read-only t)
+  (primary-condition nil :read-only t)
+  (target-results nil :read-only t)
+  (rollback-failures nil :read-only t)
+  (post-rollback-state nil :read-only t)
+  (diagnostics nil :read-only t))
+
+(cl-defstruct (tp-publication-batch-candidate
+               (:constructor tp--make-publication-batch-candidate)
+               (:copier nil))
+  "A one-shot structured view over the existing v1 transaction state."
+  (transaction-id nil :read-only t)
+  (id nil :read-only t)
+  state
+  resolution
+  (entries nil :read-only t)
+  (participants nil :read-only t)
+  (journals nil :read-only t)
+  final-accept
+  (final-accept-id nil :read-only t)
+  diagnostics
+  operation-counts
+  phase-timings
+  markers
+  success-outcome-draft
+  outcome
+  shadow-proof)
+
+(defun tp--publication-target-entry-bound-p (entry transaction-id batch-id)
+  "Return non-nil when ENTRY is exactly bound to TRANSACTION-ID and BATCH-ID."
+  (and (tp-publication-target-entry-p entry)
+       (equal transaction-id
+              (tp-publication-target-entry-transaction-id entry))
+       (equal batch-id (tp-publication-target-entry-batch-id entry))))
+
+(defun tp--publication-batch-entries-valid-p
+    (entries transaction-id batch-id)
+  "Return non-nil when ENTRIES bind TRANSACTION-ID and BATCH-ID exactly."
+  (and (proper-list-p entries)
+       entries
+       (cl-every (lambda (entry)
+                   (tp--publication-target-entry-bound-p
+                    entry transaction-id batch-id))
+                 entries)
+       (tp--proper-unique-list-p
+        (mapcar #'tp-publication-target-entry-candidate-id entries))
+       (tp--proper-unique-list-p
+        (mapcar #'tp-publication-target-entry-surface-id entries))
+       (tp--proper-unique-list-p
+        (mapcar #'tp-publication-target-entry-authority-token entries))
+       (let ((generation
+              (tp-publication-target-entry-mapping-generation (car entries))))
+         (cl-every
+          (lambda (entry)
+            (equal generation
+                   (tp-publication-target-entry-mapping-generation entry)))
+          entries))))
+
+(cl-defun tp--publication-batch-prepare
+    (&key transaction-id batch-id entries participants journals final-accept
+          diagnostics)
+  "Prepare TRANSACTION-ID and BATCH-ID over exact ENTRIES.
+PARTICIPANTS is an ordered reference vector, JOURNALS is the existing v1 state
+view, FINAL-ACCEPT is the single coordinator function, and DIAGNOSTICS contains
+known preaccept observations."
+  (unless (and transaction-id batch-id
+               (tp--publication-batch-entries-valid-p
+                entries transaction-id batch-id)
+               (vectorp participants)
+               (functionp final-accept))
+    (signal 'tp-publication-binding-error
+            (list :batch transaction-id batch-id entries participants)))
+  (tp--make-publication-batch-candidate
+   :transaction-id transaction-id
+   :id batch-id
+   :state 'prepared
+   :entries (copy-sequence entries)
+   :participants participants
+   :journals journals
+   :final-accept final-accept
+   :final-accept-id (tp--next-final-accept-id)
+   :diagnostics (tp--copy-property-value diagnostics)))
+
+(defun tp--publication-batch-terminal-p (candidate)
+  "Return non-nil when CANDIDATE has one terminal disposition."
+  (and (tp-publication-batch-candidate-p candidate)
+       (memq (tp-publication-batch-candidate-state candidate)
+             tp--publication-batch-terminal-states)))
+
+(defun tp--publication-batch-transition (candidate next)
+  "Move CANDIDATE to NEXT through its one-way state machine."
+  (unless (tp-publication-batch-candidate-p candidate)
+    (signal 'wrong-type-argument
+            (list 'tp-publication-batch-candidate-p candidate)))
+  (let* ((current (tp-publication-batch-candidate-state candidate))
+         (allowed (cdr (assq current tp--publication-batch-transitions))))
+    (unless (memq next allowed)
+      (signal 'tp-publication-state-error
+              (list :batch-state current next
+                    (tp-publication-batch-candidate-id candidate))))
+    (setf (tp-publication-batch-candidate-state candidate) next)
+    (when (memq next tp--publication-batch-terminal-states)
+      (setf (tp-publication-batch-candidate-resolution candidate) next))
+    candidate))
+
+(defun tp--publication-batch-discard (candidate reason)
+  "Discard prepared CANDIDATE for REASON and return nil."
+  (unless (and (tp-publication-batch-candidate-p candidate)
+               (eq (tp-publication-batch-candidate-state candidate) 'prepared))
+    (signal 'tp-publication-state-error
+            (list :discard
+                  (and (tp-publication-batch-candidate-p candidate)
+                       (tp-publication-batch-candidate-state candidate)))))
+  (setf (tp-publication-batch-candidate-diagnostics candidate)
+        (append (tp-publication-batch-candidate-diagnostics candidate)
+                (list (list :discard reason))))
+  (tp--publication-batch-transition candidate 'discarded)
+  nil)
+
+(defun tp--committed-success-outcome-draft
+    (candidate operation-counts phase-timings diagnostics marker-count)
+  "Preallocate CANDIDATE evidence using OPERATION-COUNTS and PHASE-TIMINGS.
+DIAGNOSTICS contains known preaccept failures and MARKER-COUNT is fixed."
+  (unless (tp-publication-batch-candidate-p candidate)
+    (signal 'wrong-type-argument
+            (list 'tp-publication-batch-candidate-p candidate)))
+  (setf (tp-publication-batch-candidate-operation-counts candidate)
+        (tp--copy-property-value operation-counts)
+        (tp-publication-batch-candidate-phase-timings candidate)
+        (tp--copy-property-value phase-timings)
+        (tp-publication-batch-candidate-diagnostics candidate)
+        (tp--copy-property-value diagnostics))
+  (tp--make-committed-success-outcome
+   :transaction-id
+   (tp-publication-batch-candidate-transaction-id candidate)
+   :final-accept-id
+   (tp-publication-batch-candidate-final-accept-id candidate)
+   :batch-id (tp-publication-batch-candidate-id candidate)
+   :entries
+   (mapcar #'tp--publication-outcome-entry-from-target
+           (tp-publication-batch-candidate-entries candidate))
+   :mapping-generation
+   (let ((entries (tp-publication-batch-candidate-entries candidate)))
+     (and entries
+          (tp-publication-target-entry-mapping-generation (car entries))))
+   :operation-counts
+   (tp--copy-property-value
+    (tp-publication-batch-candidate-operation-counts candidate))
+   :phase-timings
+   (tp--copy-property-value
+    (tp-publication-batch-candidate-phase-timings candidate))
+   :diagnostics
+   (tp--copy-property-value
+    (tp-publication-batch-candidate-diagnostics candidate))
+   :marker-count marker-count))
+
+(defun tp--committed-success-outcome-finalize (outcome)
+  "Finalize preallocated OUTCOME exactly once after final accept."
+  (unless (and (tp-committed-success-outcome-p outcome)
+               (null (tp-committed-success-outcome-tag outcome)))
+    (signal 'tp-publication-state-error (list :success-outcome outcome)))
+  ;; The slot is read-only to every accessor.  This single fixed vector write is
+  ;; the coordinator's postaccept tag finalization primitive.
+  (aset outcome tp--committed-success-outcome-tag-slot 'committed-success)
+  outcome)
+
+(defun tp--publication-outcome-entry-matches-target-p (outcome-entry target)
+  "Return non-nil when OUTCOME-ENTRY is exactly bound to TARGET."
+  (and (tp-publication-outcome-entry-p outcome-entry)
+       (tp-publication-target-entry-p target)
+       (equal (tp-publication-outcome-entry-batch-id outcome-entry)
+              (tp-publication-target-entry-batch-id target))
+       (equal (tp-publication-outcome-entry-candidate-id outcome-entry)
+              (tp-publication-target-entry-candidate-id target))
+       (equal (tp-publication-outcome-entry-surface-id outcome-entry)
+              (tp-publication-target-entry-surface-id target))
+       (equal (tp-publication-outcome-entry-mount-ids outcome-entry)
+              (tp-publication-target-entry-mount-ids target))
+       (eq (tp-publication-outcome-entry-buffer outcome-entry)
+           (tp-publication-target-entry-buffer target))
+       (eq (tp-publication-outcome-entry-authority-token outcome-entry)
+           (tp-publication-target-entry-authority-token target))
+       (= (tp-publication-outcome-entry-old-revision outcome-entry)
+          (tp-publication-target-entry-old-revision target))
+       (= (tp-publication-outcome-entry-new-revision outcome-entry)
+          (tp-publication-target-entry-new-revision target))
+       (equal (tp-publication-outcome-entry-mapping-generation outcome-entry)
+              (tp-publication-target-entry-mapping-generation target))
+       (equal (tp-publication-outcome-entry-operation-counts outcome-entry)
+              (tp-publication-target-entry-operation-counts target))))
+
+(defun tp--committed-success-outcome-valid-for-p
+    (outcome candidate &optional mapping-generation)
+  "Purely validate OUTCOME against exact CANDIDATE and MAPPING-GENERATION."
+  (and (tp-committed-success-outcome-p outcome)
+       (eq (tp-committed-success-outcome-tag outcome) 'committed-success)
+       (tp-publication-batch-candidate-p candidate)
+       (eq (tp-publication-batch-candidate-state candidate) 'committed)
+       (equal (tp-committed-success-outcome-transaction-id outcome)
+              (tp-publication-batch-candidate-transaction-id candidate))
+       (equal (tp-committed-success-outcome-batch-id outcome)
+              (tp-publication-batch-candidate-id candidate))
+       (equal (tp-committed-success-outcome-operation-counts outcome)
+              (tp-publication-batch-candidate-operation-counts candidate))
+       (equal (tp-committed-success-outcome-phase-timings outcome)
+              (tp-publication-batch-candidate-phase-timings candidate))
+       (equal (tp-committed-success-outcome-diagnostics outcome)
+              (tp-publication-batch-candidate-diagnostics candidate))
+       (= (tp-committed-success-outcome-marker-count outcome)
+          (if (consp (tp-publication-batch-candidate-markers candidate))
+              (cdr (tp-publication-batch-candidate-markers candidate))
+            0))
+       (or (null mapping-generation)
+           (equal mapping-generation
+                  (tp-committed-success-outcome-mapping-generation outcome)))
+       (let ((outcome-entries
+              (append (tp-committed-success-outcome-entries outcome) nil))
+             (targets (tp-publication-batch-candidate-entries candidate)))
+         (and (= (length outcome-entries) (length targets))
+              (cl-every #'identity
+                        (cl-mapcar
+                         #'tp--publication-outcome-entry-matches-target-p
+                         outcome-entries targets))))))
+
+(defun tp--committed-success-outcome-snapshot (outcome)
+  "Return a defensive observational plist for committed OUTCOME."
+  (unless (and (tp-committed-success-outcome-p outcome)
+               (eq (tp-committed-success-outcome-tag outcome)
+                   'committed-success))
+    (signal 'tp-publication-binding-error (list :outcome outcome)))
+  (list
+   :tag 'committed-success
+   :transaction-id (tp-committed-success-outcome-transaction-id outcome)
+   :final-accept-id (tp-committed-success-outcome-final-accept-id outcome)
+   :batch-id (tp-committed-success-outcome-batch-id outcome)
+   :entries
+   (mapcar
+    (lambda (entry)
+      (list :batch-id (tp-publication-outcome-entry-batch-id entry)
+            :candidate-id (tp-publication-outcome-entry-candidate-id entry)
+            :surface-id
+            (tp--copy-property-value
+             (tp-publication-outcome-entry-surface-id entry))
+            :mount-ids
+            (tp--copy-property-value
+             (tp-publication-outcome-entry-mount-ids entry))
+            :buffer (tp-publication-outcome-entry-buffer entry)
+            :authority-token
+            (tp-publication-outcome-entry-authority-token entry)
+            :old-revision
+            (tp-publication-outcome-entry-old-revision entry)
+            :new-revision
+            (tp-publication-outcome-entry-new-revision entry)
+            :mapping-generation
+            (tp-publication-outcome-entry-mapping-generation entry)
+            :operation-counts
+            (tp--copy-property-value
+             (tp-publication-outcome-entry-operation-counts entry))))
+    (append (tp-committed-success-outcome-entries outcome) nil))
+   :mapping-generation
+   (tp-committed-success-outcome-mapping-generation outcome)
+   :operation-counts
+   (tp--copy-property-value
+    (tp-committed-success-outcome-operation-counts outcome))
+   :phase-timings
+   (tp--copy-property-value
+    (tp-committed-success-outcome-phase-timings outcome))
+   :diagnostics
+   (tp--copy-property-value
+    (tp-committed-success-outcome-diagnostics outcome))
+   :marker-count (tp-committed-success-outcome-marker-count outcome)))
+
+(defun tp--publication-failure-outcome-valid-for-p (outcome candidate)
+  "Purely validate failure OUTCOME against rolled-back CANDIDATE."
+  (and (tp-publication-failure-outcome-p outcome)
+       (eq (tp-publication-failure-outcome-tag outcome)
+           'publication-failure)
+       (tp-publication-batch-candidate-p candidate)
+       (eq (tp-publication-batch-candidate-state candidate) 'rolled-back)
+       (equal (tp-publication-failure-outcome-transaction-id outcome)
+              (tp-publication-batch-candidate-transaction-id candidate))
+       (equal (tp-publication-failure-outcome-batch-id outcome)
+              (tp-publication-batch-candidate-id candidate))
+       (let ((results (tp-publication-failure-outcome-target-results outcome))
+             (entries (tp-publication-batch-candidate-entries candidate)))
+         (and (= (length results) (length entries))
+              (cl-every
+               #'identity
+               (cl-mapcar
+                (lambda (result entry)
+                  (and
+                   (equal (plist-get result :candidate-id)
+                          (tp-publication-target-entry-candidate-id entry))
+                   (equal (plist-get result :surface-id)
+                          (tp-publication-target-entry-surface-id entry))))
+                results entries))))))
+
+(defun tp--publication-failure-outcome-create
+    (candidate stage primary-condition rollback-failures diagnostics)
+  "Build rolled-back CANDIDATE evidence for STAGE and PRIMARY-CONDITION.
+ROLLBACK-FAILURES and DIAGNOSTICS are observational snapshots."
+  (unless (and (tp-publication-batch-candidate-p candidate)
+               (eq (tp-publication-batch-candidate-state candidate)
+                   'rolled-back))
+    (signal 'tp-publication-state-error (list :failure-outcome candidate)))
+  (let ((entries (tp-publication-batch-candidate-entries candidate)))
+    (tp--make-publication-failure-outcome
+     :transaction-id
+     (tp-publication-batch-candidate-transaction-id candidate)
+     :batch-id (tp-publication-batch-candidate-id candidate)
+     :failure-stage stage
+     :primary-condition (tp--copy-property-value primary-condition)
+     :target-results
+     (mapcar
+      (lambda (entry)
+        (list :candidate-id
+              (tp-publication-target-entry-candidate-id entry)
+              :surface-id
+              (tp--copy-property-value
+               (tp-publication-target-entry-surface-id entry))
+              :result
+              (tp--copy-property-value
+               (tp-publication-target-entry-rollback-result entry))))
+      entries)
+     :rollback-failures (tp--copy-property-value rollback-failures)
+     :post-rollback-state
+     (mapcar
+      (lambda (entry)
+        (list :candidate-id
+              (tp-publication-target-entry-candidate-id entry)
+              :surface-id
+              (tp--copy-property-value
+               (tp-publication-target-entry-surface-id entry))
+              :state
+              (tp--copy-property-value
+               (tp-publication-target-entry-post-rollback-state entry))))
+      entries)
+     :diagnostics (tp--copy-property-value diagnostics))))
+
+(cl-defstruct (tp--final-marker-operation
+               (:constructor tp--make-final-marker-operation)
+               (:copier nil))
+  "One trusted operation descriptor resolved before final accept."
+  (key nil :read-only t)
+  (validate nil :read-only t)
+  (apply nil :read-only t)
+  (restore nil :read-only t)
+  (max-slot-writes nil :read-only t))
+
+(cl-defstruct (tp-final-marker-expectation
+               (:constructor tp--make-final-marker-expectation)
+               (:copier nil))
+  "One prebuilt expected scalar stored in a fixed vector slot."
+  (target nil :read-only t)
+  (index nil :read-only t)
+  (value nil :read-only t))
+
+(cl-defstruct (tp-final-marker-slot-write
+               (:constructor tp--make-final-marker-slot-write)
+               (:copier nil))
+  "One prebuilt fixed vector slot write."
+  (target nil :read-only t)
+  (index nil :read-only t)
+  (value nil :read-only t))
+
+(defun tp--final-marker-vector-index-p (target index)
+  "Return non-nil when INDEX denotes a writable slot in TARGET."
+  (and (vectorp target) (integerp index) (<= 0 index) (< index (length target))))
+
+(cl-defun tp--final-marker-expectation-create (&key target index value)
+  "Create an expectation that TARGET slot INDEX currently equals VALUE."
+  (unless (tp--final-marker-vector-index-p target index)
+    (signal 'tp-final-marker-error (list :expectation target index)))
+  (tp--make-final-marker-expectation
+   :target target :index index :value value))
+
+(cl-defun tp--final-marker-slot-write-create (&key target index value)
+  "Create one prebuilt write of VALUE into TARGET slot INDEX."
+  (unless (tp--final-marker-vector-index-p target index)
+    (signal 'tp-final-marker-error (list :slot-write target index)))
+  (tp--make-final-marker-slot-write :target target :index index :value value))
+
+(defun tp--final-marker-expectation-current-p (expectation)
+  "Return non-nil when EXPECTATION matches its current fixed slot."
+  (and (tp-final-marker-expectation-p expectation)
+       (equal
+        (aref (tp-final-marker-expectation-target expectation)
+              (tp-final-marker-expectation-index expectation))
+        (tp-final-marker-expectation-value expectation))))
+
+(defun tp--final-marker-slot-write-shape-p (write)
+  "Return non-nil when WRITE still denotes one valid fixed vector slot."
+  (and (tp-final-marker-slot-write-p write)
+       (tp--final-marker-vector-index-p
+        (tp-final-marker-slot-write-target write)
+        (tp-final-marker-slot-write-index write))))
+
+(defun tp--final-marker-vector-payload-shape-p (marker)
+  "Return non-nil when MARKER has exact paired fixed vector slot payloads."
+  (let ((next (tp-final-accept-marker-next-values marker))
+        (inverse (tp-final-accept-marker-inverse-values marker))
+        (count (tp-final-accept-marker-slot-write-count marker))
+        seen valid)
+    (setq valid
+          (and (vectorp next) (vectorp inverse)
+               (= (length next) count) (= (length inverse) count)))
+    (let ((index 0))
+      (while (and valid (< index count))
+        (let ((next-write (aref next index))
+              (inverse-write (aref inverse index)))
+          (setq valid
+                (and
+                 (tp--final-marker-slot-write-shape-p next-write)
+                 (tp--final-marker-slot-write-shape-p inverse-write)
+                 (eq (tp-final-marker-slot-write-target next-write)
+                     (tp-final-marker-slot-write-target inverse-write))
+                 (= (tp-final-marker-slot-write-index next-write)
+                    (tp-final-marker-slot-write-index inverse-write))
+                 (not
+                  (cl-find-if
+                   (lambda (entry)
+                     (and
+                      (eq (car entry)
+                          (tp-final-marker-slot-write-target next-write))
+                      (= (cdr entry)
+                         (tp-final-marker-slot-write-index next-write))))
+                   seen))))
+          (when valid
+            (push (cons (tp-final-marker-slot-write-target next-write)
+                        (tp-final-marker-slot-write-index next-write))
+                  seen)))
+        (setq index (1+ index))))
+    valid))
+
+(defun tp--final-marker-vector-slots-validate (marker)
+  "Validate MARKER expectations and inverse values without changing state."
+  (and
+   (tp--final-marker-vector-payload-shape-p marker)
+   (tp--final-marker-expectation-current-p
+    (tp-final-accept-marker-expected-token marker))
+   (tp--final-marker-expectation-current-p
+    (tp-final-accept-marker-expected-version marker))
+   (let* ((inverse (tp-final-accept-marker-inverse-values marker))
+          (count (length inverse))
+          (index 0)
+          (valid t))
+     (while (and valid (< index count))
+       (let ((write (aref inverse index)))
+         (setq valid
+               (equal
+                (aref (tp-final-marker-slot-write-target write)
+                      (tp-final-marker-slot-write-index write))
+                (tp-final-marker-slot-write-value write))))
+       (setq index (1+ index)))
+     valid)))
+
+(defun tp--final-marker-vector-slots-apply (marker)
+  "Apply MARKER's fixed next-value vector slots in order."
+  (let* ((writes (tp-final-accept-marker-next-values marker))
+         (count (length writes))
+         (index 0))
+    (while (< index count)
+      (let ((write (aref writes index)))
+        (aset (tp-final-marker-slot-write-target write)
+              (tp-final-marker-slot-write-index write)
+              (tp-final-marker-slot-write-value write)))
+      (setq index (1+ index)))))
+
+(defun tp--final-marker-vector-slots-restore (marker)
+  "Restore MARKER's fixed inverse-value vector slots in reverse order."
+  (let* ((writes (tp-final-accept-marker-inverse-values marker))
+         (index (1- (length writes))))
+    (while (>= index 0)
+      (let ((write (aref writes index)))
+        (aset (tp-final-marker-slot-write-target write)
+              (tp-final-marker-slot-write-index write)
+              (tp-final-marker-slot-write-value write)))
+      (setq index (1- index)))))
+
+(defconst tp--final-marker-operation-whitelist
+  (list
+   (tp--make-final-marker-operation
+    :key 'tp-vector-slots/v1
+    :validate (symbol-function 'tp--final-marker-vector-slots-validate)
+    :apply (symbol-function 'tp--final-marker-vector-slots-apply)
+    :restore (symbol-function 'tp--final-marker-vector-slots-restore)
+    :max-slot-writes tp--final-marker-max-slot-writes))
+  "Closed package-owned final-marker primitive whitelist.")
+
+(defun tp--final-marker-operation-resolve (key)
+  "Return the trusted final marker operation registered for KEY."
+  (let ((operation
+         (cl-find key tp--final-marker-operation-whitelist
+                  :key #'tp--final-marker-operation-key :test #'eq)))
+    (or operation
+        (signal 'tp-final-marker-error (list :operation-not-whitelisted key)))))
+
+(cl-defstruct (tp-final-accept-marker
+               (:constructor tp--make-final-accept-marker)
+               (:copier nil))
+  "One opaque, bounded, one-shot final-accept authority marker."
+  (owner-key nil :read-only t)
+  (expected-token nil :read-only t)
+  (expected-version nil :read-only t)
+  (next-values nil :read-only t)
+  (inverse-values nil :read-only t)
+  (slot-write-count nil :read-only t)
+  (operation-key nil :read-only t)
+  (operation nil :read-only t)
+  state)
+
+(cl-defun tp--final-accept-marker-create
+    (&key owner-key expected-token expected-version next-values inverse-values
+          slot-write-count operation-key)
+  "Create an OWNER-KEY marker after resolving OPERATION-KEY.
+EXPECTED-TOKEN and EXPECTED-VERSION bind owner state.  NEXT-VALUES and
+INVERSE-VALUES are opaque prebuilt payloads with fixed SLOT-WRITE-COUNT."
+  (let ((operation (tp--final-marker-operation-resolve operation-key)))
+    (unless (and owner-key
+                 (tp-final-marker-expectation-p expected-token)
+                 (tp-final-marker-expectation-p expected-version)
+                 (integerp
+                  (tp-final-marker-expectation-value expected-version))
+                 (>= (tp-final-marker-expectation-value expected-version) 0)
+                 (integerp slot-write-count) (> slot-write-count 0)
+                 (<= slot-write-count
+                     (tp--final-marker-operation-max-slot-writes operation)))
+      (signal 'tp-final-marker-error
+              (list :marker owner-key expected-token expected-version
+                    slot-write-count operation-key)))
+    (let ((marker
+           (tp--make-final-accept-marker
+            :owner-key (tp--copy-property-value owner-key)
+            :expected-token expected-token
+            :expected-version expected-version
+            :next-values (and (vectorp next-values)
+                              (copy-sequence next-values))
+            :inverse-values (and (vectorp inverse-values)
+                                 (copy-sequence inverse-values))
+            :slot-write-count slot-write-count
+            :operation-key operation-key
+            :operation operation
+            :state 'prepared)))
+      (unless (tp--final-marker-vector-payload-shape-p marker)
+        (signal 'tp-final-marker-error
+                (list :marker-payload owner-key slot-write-count)))
+      marker)))
+
+(defun tp--final-accept-marker-validate (marker)
+  "Validate MARKER's expected owner state before the critical section."
+  (unless (and (tp-final-accept-marker-p marker)
+               (eq (tp-final-accept-marker-state marker) 'prepared)
+               (funcall
+                (tp--final-marker-operation-validate
+                 (tp-final-accept-marker-operation marker))
+                marker))
+    (signal 'tp-final-marker-error
+            (list :expected-state
+                  (and (tp-final-accept-marker-p marker)
+                       (tp-final-accept-marker-owner-key marker)))))
+  marker)
+
+(provide 'tp-transaction)
+;;; tp-transaction.el ends here

tp.el

@@ -25,6 +25,8 @@
 ;;                  canonical requests/results, and debug logging.
 ;;   tp-style.el    Native property policies, contribution composition,
 ;;                  named declarations, and explicit computed values.
+;;   tp-transaction.el
+;;                  Additive publication batch, marker, and outcome contracts.
 ;;   tp-reactive.el Exact signals, bindings, transactions, and scoped variable
 ;;                  adapters.
 ;;   tp-surface.el  Retained plans, objects, range anchors, mounts, indexes,
@@ -53,6 +55,7 @@
 
 (require 'tp-core)
 (require 'tp-style)
+(require 'tp-transaction)
 (require 'tp-reactive)
 (require 'tp-surface)
 (require 'tp-layer)
@@ -62,5 +65,20 @@
 (require 'tp-palette)
 (require 'tp-builtins)
 
+(defconst tp--runtime-manifest
+  `(:package tp :version "1.0.0"
+    :transaction-protocol ,tp-transaction-protocol
+    :batch-artifacts t
+    :batch-execution v1-bridge
+    :batch-execute nil
+    :shadow-proof t
+    :final-marker-operation tp-vector-slots/v1)
+  "Immutable package capability facts for cross-package compatibility checks.")
+
+;;;###autoload
+(defun tp-runtime-manifest ()
+  "Return a defensive snapshot of TP's package capability manifest."
+  (tp--copy-property-value tp--runtime-manifest))
+
 (provide 'tp)
 ;;; tp.el ends here