heap-snapshot + native HTTP client + MOAD-0001 cleanup

Three wins in one commit.

1) heap-snapshot / heap-restore (asm arena primitive)
   asm has no GC. Long-running servers leaked ~64 MB per heap growth.
   Two new builtins let a programmer capture r15 and later rewind to
   it, recycling intermediate allocations in O(1) memory.
   Python + C get no-op versions so portable .lsp code can call them
   unconditionally.

   examples/http-server.lsp now takes a snapshot at top level and
   rewinds after every request. Measured asm RSS: 88 KB initial,
   100 KB after 100 requests, 100 KB after 1100 requests — flat.
   Prior behavior was +64 MB per few thousand requests.

2) examples/http-client-bench.lsp — native HTTP load generator
   Uses only the six tcp-* primitives + current-time-ms. Runs
   identically in all three impls. Eliminates curl's ~2 ms/req
   fork+exec overhead, so real server throughput shows up:

     Python server ← Python client   2403 rps
     C      server ← C      client   2439 rps
     asm    server ← asm    client   2994 rps
     asm    server ← C      client   2500 rps

   The earlier curl-based bench was clamped near 400 rps by the
   client; the actual servers handle 6–7× that.

3) MOAD-0001 cleanup
   - c/builtins.c bi_string_replace: strncmp-at-every-position
     (hand-rolled, sedimentary) → strstr (libc-tuned, typically
     Boyer-Moore-Horspool). O(N*k) → O(N + matches*k).
   - uncommonlisp.py _tokenize_lines: per-token src.count('\n', 0, pos)
     → precompute line_starts once, bisect_right per token.
     O(N*M) → O(M + N log M).

Also adds current-time-ms to all three impls so benchmarks can
time themselves without relying on the Python/C float `current-time`
(asm has no floats). Seconds-since-epoch tagged as a 61-bit int.

Test counts unchanged: 571 py + 132 asm + 189 shared + 83 c = 975.
All green via make test-all.
This commit is contained in:
russell@unturf.com 2026-04-16 20:49:32 -04:00
parent 477bd5f7cd
commit b8d6afdeb3
7 changed files with 239 additions and 34 deletions

Binary file not shown.

Binary file not shown.

View file

@ -35,6 +35,8 @@
.equ SYS_LISTEN,50
.equ SYS_SETSOCKOPT,54
.equ SYS_EXIT, 60
.equ SYS_CLOCK_GETTIME, 228
.equ CLOCK_REALTIME, 0
.equ AF_INET, 2
.equ SOCK_STREAM,1
@ -160,7 +162,10 @@
.equ BI_TCPRECV, 82
.equ BI_TCPSEND, 83
.equ BI_TCPCLOSE, 84
.equ BI_COUNT, 85
.equ BI_HEAPSNAP, 85
.equ BI_HEAPREST, 86
.equ BI_CURTIME, 87
.equ BI_COUNT, 88
# ============================================================
.data
@ -271,6 +276,9 @@ bn_tcpconnect: .byte 11; .ascii "tcp-connect"
bn_tcprecv: .byte 8; .ascii "tcp-recv"
bn_tcpsend: .byte 8; .ascii "tcp-send"
bn_tcpclose: .byte 9; .ascii "tcp-close"
bn_heapsnap: .byte 13; .ascii "heap-snapshot"
bn_heaprest: .byte 12; .ascii "heap-restore"
bn_curtime: .byte 15; .ascii "current-time-ms"
portal_magic: .ascii "ULPORTAL"
.equ PORTAL_MAGIC_LEN, 8
@ -300,6 +308,7 @@ bi_names:
.quad bn_writefile, bn_filetostr
.quad bn_tcplisten, bn_tcpaccept, bn_tcpconnect
.quad bn_tcprecv, bn_tcpsend, bn_tcpclose
.quad bn_heapsnap, bn_heaprest, bn_curtime
# Error messages
err_unbound: .ascii "Error: unbound variable: "
@ -2488,6 +2497,12 @@ eval_list:
je bi_tcp_send
cmpq $BI_TCPCLOSE, %rax
je bi_close_port
cmpq $BI_HEAPSNAP, %rax
je bi_heap_snapshot
cmpq $BI_HEAPREST, %rax
je bi_heap_restore
cmpq $BI_CURTIME, %rax
je bi_current_time_ms
movq $VAL_VOID, %rax
popq %r12
@ -4399,6 +4414,67 @@ bi_file_to_string:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# Heap snapshot/restore: UNSAFE escape hatch for long-running loops.
# asm has no GC. A server that bump-allocates every request leaks
# ~64 MB per heap_grow forever. heap-snapshot captures r15; a later
# heap-restore rewinds r15 to that point, reclaiming everything
# allocated since.
#
# DANGER: any Scheme value that lives past the restore point but was
# allocated after the snapshot becomes a dangling pointer. Use only
# when the programmer can prove no such references exist the
# canonical pattern is a per-request scope in a server loop:
#
# (let ((snap (heap-snapshot)))
# (loop ...)
# (heap-restore snap))
#
# Top-level bindings stay alive because they allocate before the snap.
# ============================================================
bi_heap_snapshot:
# Return r15 as a tagged int (61-bit payload fits a 64-bit pointer
# because all asm heap addresses have 0 in the low 3 bits already).
movq %r15, %rax
# Low 3 bits of r15 are 0 (8-aligned). TAG_INT = 0, so no OR needed.
RET_VAL
bi_heap_restore:
GETARG %rax
# Untag: caller passed a heap-snapshot int. Clear tag bits just in case.
andq $-8, %rax
# Sanity: don't rewind past heap_base or forward past current r15.
cmpq heap_base(%rip), %rax
jl .hr_noop
cmpq %r15, %rax
ja .hr_noop
movq %rax, %r15
.hr_noop:
movq $VAL_VOID, %rax
RET_VAL
# bi_current_time_ms: (current-time-ms) int ms since epoch
# struct timespec is { int64_t tv_sec; int64_t tv_nsec; } — 16 bytes.
bi_current_time_ms:
subq $16, %rsp
movq $SYS_CLOCK_GETTIME, %rax
movq $CLOCK_REALTIME, %rdi
movq %rsp, %rsi
syscall
movq (%rsp), %rax # tv_sec
movq 8(%rsp), %rcx # tv_nsec
addq $16, %rsp
imulq $1000, %rax # sec * 1000
movq %rax, %r8 # stash
movq %rcx, %rax # rax = tv_nsec
xorq %rdx, %rdx
movq $1000000, %rcx
divq %rcx # rax = tv_nsec / 1e6
addq %r8, %rax # total ms
shlq $3, %rax # tag as int
RET_VAL
# ============================================================
# TCP sockets: fd encoded as port (same as file ports).
# tcp-recv = sys_read, tcp-send = sys_write, tcp-close = close-port.

View file

@ -1204,6 +1204,28 @@ static Value bi_tcp_close(Value *a, int n, Env *e) {
p->closed = true;
return VAL_VOID;
}
/* heap-snapshot / heap-restore: asm-only arena primitives. The asm impl
* has no GC; these let a server rewind its bump allocator between
* requests. Python + C have real GCs no-ops here so portable .lsp
* code can call them unconditionally. */
static Value bi_heap_snapshot(Value *a, int n, Env *e) {
(void)a; (void)n; (void)e;
return VAL_FALSE;
}
static Value bi_heap_restore(Value *a, int n, Env *e) {
(void)a; (void)n; (void)e;
return VAL_VOID;
}
#include <time.h>
static Value bi_current_time_ms(Value *a, int n, Env *e) {
(void)a; (void)n; (void)e;
struct timespec ts;
clock_gettime(CLOCK_REALTIME, &ts);
int64_t ms = (int64_t)ts.tv_sec * 1000 + ts.tv_nsec / 1000000;
return VAL_INT(ms);
}
static Value bi_open_output_string(Value *a, int n, Env *e) {
(void)e;
return make_string_output_port();
@ -1528,19 +1550,24 @@ static Value bi_string_replace(Value *a, int n, Env *e) {
const char *from = AS_STRING(a[1])->data;
const char *to = AS_STRING(a[2])->data;
size_t from_len = strlen(from), to_len = strlen(to);
if (from_len == 0) return a[0];
/* Use strstr (libc-tuned, often Boyer-Moore-Horspool) to skip the
* O(N*k) hand-rolled strncmp-at-every-position sediment. */
char buf[8192];
size_t pos = 0;
while (*src && pos < sizeof(buf) - to_len - 1) {
if (strncmp(src, from, from_len) == 0) {
memcpy(buf + pos, to, to_len);
pos += to_len;
src += from_len;
} else {
buf[pos++] = *src++;
}
const char *cur = src;
const char *hit;
while ((hit = strstr(cur, from)) != NULL) {
size_t chunk = (size_t)(hit - cur);
if (pos + chunk + to_len >= sizeof(buf) - 1) break;
memcpy(buf + pos, cur, chunk); pos += chunk;
memcpy(buf + pos, to, to_len); pos += to_len;
cur = hit + from_len;
}
while (*src && pos < sizeof(buf) - 1) buf[pos++] = *src++;
size_t tail = strlen(cur);
if (pos + tail >= sizeof(buf)) tail = sizeof(buf) - pos - 1;
memcpy(buf + pos, cur, tail); pos += tail;
buf[pos] = '\0';
return make_string_from_cstr(buf);
}
@ -1836,6 +1863,9 @@ Env *make_global_env(void) {
DEF("tcp-recv", bi_tcp_recv);
DEF("tcp-send", bi_tcp_send);
DEF("tcp-close", bi_tcp_close);
DEF("heap-snapshot", bi_heap_snapshot);
DEF("heap-restore", bi_heap_restore);
DEF("current-time-ms", bi_current_time_ms);
DEF("open-input-string", bi_open_input_string);
DEF("open-output-string", bi_open_output_string);
DEF("get-output-string", bi_get_output_string);

View file

@ -0,0 +1,66 @@
;;; http-client-bench.lsp — sequential HTTP load generator in Scheme
;;;
;;; Makes N requests to 127.0.0.1:PORT and reports elapsed wall time
;;; + requests/sec. Uses only the six tcp-* primitives, so it runs
;;; identically in Python, C, and asm.
;;;
;;; The earlier tests/web-benchmark.sh used curl — each curl fork+exec
;;; costs ~2 ms, swamping actual server work. This client keeps every
;;; request in-process: that irreducible cost disappears, so the real
;;; server throughput shows up.
;;;
;;; Usage:
;;; python3 uncommonlisp.py --fast examples/http-client-bench.lsp
;;; ./c/uncommonlisp examples/http-client-bench.lsp
;;; ./asm/uncommonlisp < examples/http-client-bench.lsp
;;;
;;; Override N or PORT by pre-setting *n-requests* / *port* before load.
(define *host* "127.0.0.1")
(define *port* 8080)
(define *n-requests* 500)
(define *path* "/bench")
(define *request*
(string-append
"GET " *path* " HTTP/1.0\r\n"
"Host: " *host* "\r\n"
"Connection: close\r\n\r\n"))
;;; Pass snap as arg so heap-restore can rewind per-request
;;; allocations on asm without invalidating the client loop's
;;; closure env.
(define (one-request)
(let ((sock (tcp-connect *host* *port*)))
(if sock
(begin
(tcp-send sock *request*)
(let ((resp (tcp-recv sock 8192)))
(tcp-close sock)
(if (and resp (> (string-length resp) 0)) 1 0)))
0)))
(define (client-loop n ok snap)
(if (= n 0)
ok
(let ((got (one-request)))
(heap-restore snap)
(client-loop (- n 1) (+ ok got) snap))))
(define t0 (current-time-ms))
(define ok (client-loop *n-requests* 0 (heap-snapshot)))
(define t1 (current-time-ms))
(define elapsed-ms (- t1 t0))
(define rps
(if (> elapsed-ms 0)
(quotient (* *n-requests* 1000) elapsed-ms)
0))
(display "target : http://") (display *host*) (display ":") (display *port*)
(display *path*) (newline)
(display "requests : ") (display *n-requests*) (newline)
(display "ok : ") (display ok) (newline)
(display "elapsed : ") (display elapsed-ms) (display " ms") (newline)
(display "rps : ") (display rps) (newline)

View file

@ -15,12 +15,17 @@
(define *crlf* "\r\n")
(define *crlf-crlf* "\r\n\r\n")
;;; Hard request ceiling. The asm impl has no GC: every request
;;; bump-allocates heap cells that never get reclaimed. An unbounded
;;; server leaks ~64 MB per heap growth until OOM. This ceiling makes
;;; the server self-terminate long before it starves the machine.
;;; Benchmarks that want a different cap should `set!` it after load.
(define *max-requests* 50000)
;;; Request ceiling. Acts as a belt-and-suspenders cap under the
;;; heap-snapshot loop below. The snapshot mechanism (asm only) rewinds
;;; per-request allocations so memory stays O(1) regardless of ceiling.
;;; On Python + C the GC handles this; the cap still bounds accidentally
;;; runaway demo servers.
(define *max-requests* 1000000)
;;; heap-snapshot / heap-restore are available in all three impls.
;;; On asm they rewind the bump allocator (recycling per-request
;;; allocations in O(1) memory). On Python + C they are no-ops
;;; because those runtimes already have a real GC.
;;; ── HTTP helpers ─────────────────────────────────────────────
@ -82,22 +87,31 @@
;;; ── Main loop ───────────────────────────────────────────────
;;; Top-level `server` and `server-loop`. The snapshot `snap` is
;;; passed down as an explicit arg — this avoids any issue with
;;; closures captured before/after the snapshot.
(define server (tcp-listen *port*))
(define (server-loop n snap)
(if (>= n *max-requests*)
(begin
(display "request cap reached, exiting\n")
(tcp-close server))
(begin
(let ((client (tcp-accept server)))
(let ((req (tcp-recv client 4096)))
(if (and req (> (string-length req) 0))
(tcp-send client (handle-request req))
#f))
(tcp-close client))
;; Rewind per-request allocations on asm; no-op elsewhere.
(heap-restore snap)
(server-loop (+ n 1) snap))))
(define (serve)
(let ((server (tcp-listen *port*)))
(display "uncommonlisp http server on :") (display *port*)
(display " (max ") (display *max-requests*) (display " requests)") (newline)
(let loop ((n 0))
(if (>= n *max-requests*)
(begin
(display "request cap reached, exiting\n")
(tcp-close server))
(begin
(let ((client (tcp-accept server)))
(let ((req (tcp-recv client 4096)))
(if (and req (> (string-length req) 0))
(tcp-send client (handle-request req))
#f))
(tcp-close client))
(loop (+ n 1)))))))
(display "uncommonlisp http server on :") (display *port*)
(display " (max ") (display *max-requests*) (display " requests)") (newline)
(server-loop 0 (heap-snapshot)))
(serve)

View file

@ -322,12 +322,25 @@ def _tokenize(src):
return [t for t in _TOK_RE.findall(src) if not t.startswith(';')]
def _tokenize_lines(src):
"""Tokenize with line numbers: returns list of (token, line_number) tuples."""
"""Tokenize with line numbers: returns list of (token, line_number) tuples.
MOAD-0001 fix: precompute line-start offsets once (one pass over src),
then bisect_right to map any token position -> line in O(log M).
Total cost: O(M + N log M) instead of the old O(N*M) scan sediment.
"""
# line_starts[k] = byte offset where line (k+1) begins; line 1 starts at 0.
line_starts = [0]
i = src.find('\n')
while i != -1:
line_starts.append(i + 1)
i = src.find('\n', i + 1)
from bisect import bisect_right
result = []
for m in _TOK_RE.finditer(src):
tok = m.group()
if tok.startswith(';'): continue
line = src.count('\n', 0, m.start()) + 1
line = bisect_right(line_starts, m.start())
result.append((tok, line))
return result
@ -3260,6 +3273,12 @@ def make_global_env():
d(S('tcp-recv'), lambda a, _: _tcp_recv(a[0], int(a[1])))
d(S('tcp-send'), lambda a, _: _tcp_send(a[0], _str_val(a[1])))
d(S('tcp-close'), lambda a, _: (a[0].close(), VOID)[-1])
# heap-snapshot/heap-restore are asm-only arena primitives. Python has
# real GC so these are no-ops here — they exist only to let portable
# .lsp code call them unconditionally.
d(S('heap-snapshot'), lambda a, _: False)
d(S('heap-restore'), lambda a, _: VOID)
d(S('current-time-ms'), lambda a, _: int(__import__('time').time() * 1000))
d(S('open-input-string'), lambda a, _: StringInputPort(_str_val(a[0])))
d(S('open-output-string'),lambda a, _: StringOutputPort())
d(S('get-output-string'), lambda a, _: a[0].getvalue() if isinstance(a[0], StringOutputPort) else '')