Commitbd98a9faRecorded28 Oct 2026Repositorysigil-wm

Retry input replies when the command queue is full

Changed
 Makefile                       |  3 +++
 README.md                      |  7 +++++++
 docs/design.md                 |  9 +++++++++
 scripts/test-input-reply-queue | 25 +++++++++++++++++++++++++
 src/sigil/wm/input.sgl         | 19 +++++++++++--------
 test/input-queue-gate.c        | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/input-reply-queue.sgl     | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 222 insertions(+), 8 deletions(-)
Diff
Makefilemodified
@@ -8,6 +8,9 @@ PROTOCOLS = $(shell pkg-config --variable=pkgdatadir wayland-protocols)
8
9
all: build/libsigil-wm.so build/environment-exec
10
+11
build/input-queue-gate.so: test/input-queue-gate.c build/libsigil-wm.so
+12
$(CC) $(CFLAGS) $(CPPFLAGS) -fPIC -shared $< $(LDFLAGS) $(LDLIBS) -o $@
+13
14
build/trace-records-test: test/trace-records.c src/c/trace-records.h
15
mkdir -p build
16
$(CC) -std=c11 -O2 -Wall -Wextra -Werror -D_POSIX_C_SOURCE=200809L $< -o $@
README.mdmodified
@@ -84,6 +84,13 @@ state. The socket permits arbitrary Sigil evaluation with the user's authority.
84
The real-client tests run through `scripts/test-examples`; they retain logs,
85
composed-output captures and PNGs under `build/receipts/`.
86
+87
`scripts/test-input-reply-queue` fills the 1024-command ring while a key, button
+88
or motion hook is returning its decision. A test-only native gate pauses
+89
consumption, and another scheduler task releases it to verify cooperative
+90
backpressure, accepted replies and subsequent input progress. It also checks
+91
replies after shutdown with an empty ring. Set `SIGIL` to a runtime with FFI
+92
loading support; logs are retained under `build/receipts/input-reply-queue/`.
+93
94
`scripts/test-lock-presentation` uses a test-only presentation barrier to check
95
that a blank lock owner cannot be acknowledged before actual output
96
presentation, that ordinary pixels remain covered, and that authenticated
docs/design.mdmodified
@@ -98,6 +98,15 @@ hook drops or fails; dropped presses suppress their releases. Buttons use the
98
same pairing rules. Physical and client-visible modifier state are tracked
99
separately. A hook exception drops a new press and reports an error. Replies
100
carrying stale focus/lock generations are rejected, with held-state cleanup.
+101
+102
Decision replies share the 1024-entry command ring with configuration, scene
+103
and focus commands. When it fills, Sigil retains the computed reply and sleeps
+104
cooperatively for 1 ms between enqueue attempts, without repeating the hook.
+105
Keeping the reply in this FIFO preserves earlier hook commands, including focus
+106
authorization. A reserved queue or priority lane could overtake those commands.
+107
Retry ends when the reply is accepted or the native receiver has shut down;
+108
shutdown cannot leave an active intercepted input waiting for that reply.
+109
110
Intercepted decisions are observed after 32 ms, with at most one 10 ms timer
111
interval of granularity. An unanswered intercepted press is logged and keeps
112
waiting for policy, without exposing a manager chord to a client. Ordinary
scripts/test-input-reply-queueadded
@@ -0,0 +1,25 @@
+1
#!/usr/bin/env bash
+2
set -euo pipefail
+3
cd -P "$(dirname "$0")/.."
+4
make -j2 all build/input-queue-gate.so
+5
test_runtime=$(mktemp -d /tmp/wm-input-queue.XXXXXX)
+6
trap 'rm -rf "$test_runtime"' EXIT
+7
chmod 700 "$test_runtime"
+8
export XDG_RUNTIME_DIR=$test_runtime WLR_BACKENDS=headless WLR_RENDERER=pixman WLR_HEADLESS_OUTPUTS=1
+9
unset WAYLAND_DISPLAY DISPLAY
+10
export SIGIL_WM_LIBRARY=$PWD/build/input-queue-gate.so
+11
mkdir -p build/receipts/input-reply-queue
+12
for kind in 30 31 32; do
+13
log=build/receipts/input-reply-queue/kind-$kind.log
+14
WM_INPUT_MODE=overflow WM_INPUT_KIND=$kind timeout --foreground 15 "${SIGIL:-sigil}" -L src eval -f test/input-reply-queue.sgl > "$log" 2>&1 || { cat "$log"; exit 1; }
+15
cat "$log"
+16
grep -q "^INPUT_REPLY_QUEUE=PASS kind=$kind " "$log"
+17
! grep -q 'event handler failed' "$log"
+18
done
+19
for kind in 30 31 32; do
+20
log=build/receipts/input-reply-queue/shutdown-$kind.log
+21
WM_INPUT_MODE=shutdown WM_INPUT_KIND=$kind timeout --foreground 15 "${SIGIL:-sigil}" -L src eval -f test/input-reply-queue.sgl > "$log" 2>&1 || { cat "$log"; exit 1; }
+22
cat "$log"
+23
grep -q "^INPUT_SHUTDOWN=PASS kind=$kind" "$log"
+24
! grep -q 'event handler failed' "$log"
+25
done
src/sigil/wm/input.sglmodified
@@ -1,6 +1,6 @@
1
;;; Per-event decisions execute on the Sigil scheduler, outside native callbacks.
2
(define-library (sigil wm input)
−3
(import (sigil struct) (sigil list) (sigil wm runtime))
+3
(import (sigil struct) (sigil list) (only (sigil time) sleep) (sigil wm runtime))
4
(export input-event input-event? input-event-kind input-event-token input-event-device
5
input-event-time input-event-code input-event-state input-event-modifiers
6
input-event-focus input-event-generation input-event-origin input-event-x input-event-y input-event-keysyms
@@ -102,13 +102,16 @@
102
result)))
103
(disposition (car result))
104
(replacement (or (cadr result) event)))
−105
(unless (host-send! host
−106
(list 11 (input-event-token event) disposition
−107
(if (= (input-event-kind event) 32) 0 (input-event-code replacement))
−108
(inexact->exact (round (* 1000 (input-event-x replacement))))
−109
(inexact->exact (round (* 1000 (input-event-y replacement))))
−110
(input-event-modifiers replacement)))
−111
(error "input reply queue full"))))
+105
(let ((reply (list 11 (input-event-token event) disposition
+106
(if (= (input-event-kind event) 32) 0 (input-event-code replacement))
+107
(inexact->exact (round (* 1000 (input-event-x replacement))))
+108
(inexact->exact (round (* 1000 (input-event-y replacement))))
+109
(input-event-modifiers replacement))))
+110
;; Preserve command order while yielding until the native queue has space.
+111
(let retry ()
+112
(unless (or (host-send! host reply) (not (host-running? host)))
+113
(sleep .001)
+114
(retry))))))
115
116
(define (install-input-dispatch! host)
117
(or (wm-host-input-handler host)
test/input-queue-gate.cadded
@@ -0,0 +1,71 @@
+1
/* SPDX-License-Identifier: BSD-3-Clause */
+2
#include <unistd.h>
+3
static ssize_t gated_read(int fd,void *buffer,size_t count);
+4
#define read(...) gated_read(__VA_ARGS__)
+5
#define wm_send unrecorded_send
+6
#include "../src/c/host.c"
+7
#undef wm_send
+8
#undef read
+9
+10
static atomic_bool hold_commands,commands_held;
+11
static unsigned reply_attempts,reply_refused,reply_accepted;
+12
+13
int wm_send(const struct wm_message *message) {
+14
int result=unrecorded_send(message);
+15
if(message && message->word[0]==11) {
+16
reply_attempts++;
+17
if(result) reply_accepted++;
+18
else reply_refused++;
+19
}
+20
return result;
+21
}
+22
+23
int wm_test_reply_stat(int index) {
+24
switch(index) {
+25
case 0: return reply_attempts;
+26
case 1: return reply_refused;
+27
case 2: return reply_accepted;
+28
default: return -1;
+29
}
+30
}
+31
+32
/* Pausing command consumption makes saturation independent of thread timing. */
+33
static ssize_t gated_read(int fd,void *buffer,size_t count) {
+34
if(fd==bridge.command_fd && atomic_load(&hold_commands)) {
+35
atomic_store(&commands_held,true);
+36
uint64_t deadline=now_ms()+3000;
+37
while(atomic_load(&hold_commands) && now_ms()<deadline) {
+38
struct timespec delay={.tv_nsec=500000};
+39
nanosleep(&delay,NULL);
+40
}
+41
atomic_store(&commands_held,false);
+42
}
+43
return read(fd,buffer,count);
+44
}
+45
+46
int wm_test_gate(int hold) {
+47
atomic_store(&hold_commands,hold!=0);
+48
if(!hold) return 1;
+49
struct wm_message command={.word={14,3}};
+50
if(!wm_send(&command)) return 0;
+51
uint64_t deadline=now_ms()+1000;
+52
while(!atomic_load(&commands_held)) {
+53
if(now_ms()>=deadline) return 0;
+54
struct timespec delay={.tv_nsec=500000};
+55
nanosleep(&delay,NULL);
+56
}
+57
return 1;
+58
}
+59
+60
int wm_test_queued(int kind) {
+61
if(!atomic_load(&commands_held)) return -1;
+62
unsigned first=atomic_load(&bridge.commands.read),last=atomic_load(&bridge.commands.write);
+63
unsigned count=0;
+64
for(unsigned i=first;i!=last;i++)
+65
if(!kind || bridge.commands.entries[i%QUEUE_SIZE].word[0]==kind) count++;
+66
return count;
+67
}
+68
+69
int wm_test_depth(void) {
+70
return atomic_load(&bridge.commands.write)-atomic_load(&bridge.commands.read);
+71
}
test/input-reply-queue.sgladded
@@ -0,0 +1,96 @@
+1
(import (sigil async) (sigil io) (sigil ffi) (sigil process) (sigil time)
+2
(sigil wm host) (sigil wm input)
+3
(only (sigil wm runtime) host-send! wm-host-stopped?))
+4
(define (check value message) (unless value (error message)))
+5
(define (now-ms) (inexact->exact (round (* 1000 (/ (current-jiffy) (jiffies-per-second))))))
+6
(define (await predicate)
+7
(let loop ((n 0))
+8
(unless (predicate)
+9
(check (< n 600) "input reply queue timeout")
+10
(sleep .005) (loop (+ n 1)))))
+11
(define fixture (c-library (getenv "SIGIL_WM_LIBRARY")))
+12
(define gate (c-function fixture "wm_test_gate" (list ffi/int) ffi/int))
+13
(define queued (c-function fixture "wm_test_queued" (list ffi/int) ffi/int))
+14
(define depth (c-function fixture "wm_test_depth" '() ffi/int))
+15
(define reply-stat (c-function fixture "wm_test_reply_stat" (list ffi/int) ffi/int))
+16
(define mode (or (getenv "WM_INPUT_MODE") "overflow"))
+17
(define kind (string->number (or (getenv "WM_INPUT_KIND") "30")))
+18
(define host (start-host!))
+19
(define ready? #f)
+20
(define completed '())
+21
(define observed '())
+22
(define saved #f)
+23
(define filled? #f)
+24
(define released? #f)
+25
(define start 0)
+26
(on-event! host (lambda (event)
+27
(case (event-type event)
+28
((ready) (set! ready? #t))
+29
((input-completed) (set! completed (cons (event-ref event id:) completed))))))
+30
(define (hook event)
+31
(set! observed (cons event observed))
+32
(unless saved
+33
(set! saved event)
+34
(if (equal? mode "shutdown")
+35
(begin
+36
(check (stop-host! host) "stop command refused")
+37
(await (lambda () (not (host-running? host))))
+38
(check (= (depth) 0) "shutdown command queue not empty")
+39
(display "SHUTDOWN_REPLY queued=0 reply-kind=") (display kind) (newline))
+40
(begin
+41
(check (= (gate 1) 1) "native command gate failed")
+42
(let loop () (when (set-seat-capabilities! host 3) (loop)))
+43
(check (= (queued 0) 1024) "unexpected command queue capacity")
+44
(check (= (queued 14) 1024) "unexpected queued command kinds")
+45
(display "QUEUE_FULL capacity=1024 commands=14:1024 reply-kind=")
+46
(display (input-event-kind event)) (newline)
+47
(set! start (now-ms))
+48
(set! filled? #t)
+49
(go (sleep .075) (gate 0) (set! released? #t)))))
+50
(drop))
+51
(with-async
+52
(go (run-host! host))
+53
(await (lambda () ready?))
+54
(set-key-hook! host hook)
+55
(set-button-hook! host hook)
+56
(check (configure-keyboard! host 1 "us" 25 600) "keyboard setup refused")
+57
(when (= kind 32) (set-motion-hook! host hook 0 0 '(0 0 800 600)))
+58
(sleep .05)
+59
(let ((first (case kind
+60
((30) (emulate-key! host 1 30 #t))
+61
((31) (emulate-button! host 1 272 #t))
+62
((32) (emulate-motion! host 1 20 20)))))
+63
(check first "input emulation refused")
+64
(await (lambda () saved))
+65
(cond
+66
((equal? mode "shutdown")
+67
(await (lambda () (wm-host-stopped? host)))
+68
(check (= (reply-stat 0) 1) "shutdown reply retried without a receiver")
+69
(display "INPUT_SHUTDOWN=PASS kind=") (display kind) (newline))
+70
((equal? mode "probe")
+71
(await (lambda () released?))
+72
(let ((second (emulate-key! host 1 31 #t)))
+73
(check second "following key refused")
+74
(sleep 1.1)
+75
(check (not (memv first completed)) "lost bound input unexpectedly completed")
+76
(check (= (length observed) 1) "following bound key escaped lost decision")
+77
(display "BOUND_LOST kind=") (display kind)
+78
(display " retained-ms=") (display (- (now-ms) start))
+79
(display " following-key-blocked=yes\n")
+80
(check (host-send! host (list 11 (input-event-token saved) 0 (input-event-code saved) 0 0 0))
+81
"recovery reply refused")
+82
(await (lambda () (and (memv first completed) (memv second completed))))
+83
(display "BOUND_RECOVERED=PASS explicit-reply\n")))
+84
(else
+85
(await (lambda () (memv first completed)))
+86
(check filled? "input hook never filled queue")
+87
(check released? "reply did not wait for queue space")
+88
(let ((second (emulate-key! host 1 31 #t)))
+89
(await (lambda () (memv second completed))))
+90
(check (= (length observed) 2) "input hook repeated or following key blocked")
+91
(check (> (reply-stat 1) 0) "reply never encountered backpressure")
+92
(check (= (reply-stat 2) 2) "input reply silently lost")
+93
(display "INPUT_REPLY_QUEUE=PASS kind=") (display kind)
+94
(display " elapsed-ms=") (display (- (now-ms) start)) (newline)))
+95
(unless (equal? mode "shutdown") (check (stop-host! host) "stop refused"))))
+96
(for-each (lambda (index) (check (= (host-statistic host index) 0) "native resources or events retained")) '(1 2 3 4))